www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\ND_class_function.asp
<%
'**************************************************************
' 新 动 软 网 站 管 理 系 统
' 官 方 网 站: http://www.aspcpu.com
' 系 统 作 者: 阮 丁 远(网名：天 下 程 序)
' Copyright (C) 新 动 软 网 站 管 理 系 统 版权所有
'**************************************************************
dim nd1_label_sql,nd1_label_type,nd1_label_code,nd_conn_var_str,errrstrra,copy_l_errmsg,iscrtfile,ist_msg,use_http_url,errrstrrb
dim nd1_label_params,nd1_label_fenye_num,nd1_label_beizhu,http_url_err,CacheTempx,use_http_post,PostData_G,RefererUrl_G,is_trusted_url,url_beeped_count
dim nd1_is_sys_label,err1,nd1_other_params,nd1_l_name,complie_dir,h_curfile,h_aaa,sqlxxx1112,rsxxx1112,have_label,h_db_bked,h_db_aa,h_db_bb,cpml_is_cms,glbal_page_splt_str
dim nd_ggbol_funstr11conn,nd_ggbol_funstr1a,nd_ggbol_funstr2b,nd_ggbol_funstr3c,nd_ggbol_funstr2d,nd_ggbol_funstr2e,conn_is_closed
conn_is_closed=0
'下面这一行千万不要改
h_curfile="xxxfirstned"
'下面这一行千万不要改
nd_conn_var_str="newdsoft_conn_obj"
'下面这一行千万不要改
iscrtfile="x_rundiy_indexscript_ndsoft.xml"
w_web_config_template="ND_new_script_xml_template.xml"
w_files_config="x_rundiy_menu_web_file_name_xml_ndsoft.xml"
w_files_config_template="ND_new_all_filesname_config_xml_template.xml"
'---------------------------------------slp--------------
Set ObjXMLHTTP_slp=Server.CreateObject("MSXML2.serverXMLHTTP")
'aspfile_ajax_htmed:
nd_sleep_x_times_a=1
'htmfile_ajax_htmed:
nd_sleep_x_times_b=1
'label_complie:
nd_sleep_x_times_cmple=1
'下面这个必须为0，不然太卡:
nd_sleep_x_times_htmd_gethref=0
nd_sleep_x_times_kz_downpic=2
'下面这个必须为0，不然太卡:
nd_sleep_x_times_kz_gethref=0
'下面这个必须为0，不然太卡:
nd_sleep_x_times_kz_gethref_pic=0
'本函数利用MSXML2.serverXMLHTTP超时态来使asp延时，以使cpu不会100%,此XMLHTTP必须调用一个不存在的文件才能达到所要的延时效果
function nd_process_sleep(ccc)
on error resume next
Server.ScriptTimeout=99999
'容错很重要，因为本函数利用MSXML2.serverXMLHTTP超时态来使asp延时，以使cpu不会100%:
ServerName = Request.ServerVariables("SERVER_NAME")
ServerPort = Request.ServerVariables("SERVER_PORT")
ScriptName = Request.ServerVariables("SCRIPT_NAME")
QueryString = Request.ServerVariables("QUERY_STRING")
Url="http://"&ServerName
If ServerPort <> "80" Then Url = Url & ":" & ServerPort
' 此XMLHTTP必须调用一个不存在的文件才能达到所要的延时效果:
' 此XMLHTTP必须调用一个不存在的文件才能达到所要的延时效果:
weburl=Url&RelativePath2RootPathvsp(dir_set&"inc/must_use_not_exist_file.asp")
'ccc为0则不进入延时:
for spii=1 to ccc
ObjXMLHTTP_slp.setTimeouts 1,1,1,1
'请求文件,以异步形式
ObjXMLHTTP_slp.Open "GET",weburl,False
ObjXMLHTTP_slp.send
next
end function
Function RelativePath2RootPathvsp(url)
'Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPathvsp = sTempUrl
Exit Function
End If
'Dim m_strPath
m_strPath = Request.ServerVariables("SCRIPT_NAME")
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
Loop
RelativePath2RootPathvsp = m_strPath & "/" & sTempUrl
End Function
'---------------------------------------slp--------------
'缓存路径,用于多个本系统并存的情况，防止冲突
CacheTempx = LCase(Trim(Request.ServerVariables("SCRIPT_NAME")))
CacheTempx = Left(CacheTempx, InStrRev(CacheTempx, "/"))
CacheTempx = Replace(CacheTempx, "\", "_")
CacheTempx = Replace(CacheTempx, "/", "_")
CacheTempx = "newdsoft" & CacheTempx
execute("aaee1e=sy"&"s_u"&"r"&"l_"&"g"&"et")
execute("aaee1e2=sy"&"s_ur"&"l_g"&"et"&"_b")
if cstr(aaee1e)<>cstr(aaee1e2) or aaee1e="" then
response.redirect "../D_admin"&"_s"&"e.asp"
response.end
end if
use_http_url=0
http_url_err=0
use_http_post=0
is_trusted_url=0
url_beeped_count=""
If Request.ServerVariables("SERVER_PORT") = "80" Then
GetSiteUrl = "http://" & Request.ServerVariables("server_name")
Else
GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
End If
weerbnamb = GetSiteUrl
if Request.ServerVariables("QUERY_STRING")<>"" then
RefererUrl_G=weerbnamb&Request.ServerVariables("URL")&"?"&Request.ServerVariables("QUERY_STRING")
else
RefererUrl_G=weerbnamb&Request.ServerVariables("URL")
end if
function replace_asp(cont)
cont=replace(cont,chr(60)&chr(37),"$$sx_aspcodex_startx1$")
cont=replace(cont,chr(37)&chr(62),"$$sx_aspcodex_endx1$")
cont=replace(cont,"|","$$sx_fengex1$")
cont=replace(cont,":","$$sx_maohao$")
cont=replace_huanhang(cont)
cont=replace_when_save(cont)
replace_asp=cont
end function
function replace_huanhang(cont)
cont=replace(cont,vbcrlf,"$$sx_aspcodex_huanhang$")
cont=replace(cont,chr(10),"$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(13), "$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(9), "$$sx_aspcodex_huanhang$")
replace_huanhang=cont
end function
function replace_asp_huanyuan(cont)
cont=replace(cont,"$$sx_aspcodex_startx1$",chr(60)&chr(37))
cont=replace(cont,"$$sx_aspcodex_endx1$",chr(37)&chr(62))
'防止与asp代码段的结束符冲突而在dreamweaver里编辑标签时异常,且script优先级大于textarea
cont=replace(cont,"</s"&"cript>","$----不要改本处----tempit----$/s"&"cript>",1,-1,1)
'script优先级大于textarea
cont=replace(cont,"<s"&"cript","$----不要改本处----tempit----$s"&"cript",1,-1,1)
cont=replace(cont,"<!--","$--ned_不要改本处---zhushi--$",1,-1,1)
'huanyuan用于显示，为了防止冲突,故以下把</textarea替换为$-$/textarea$-$之类
cont=replace(cont,"<textarea","$-$textarea",1,-1,1)
cont=replace(cont,"</textarea>","$-$/textarea$-$",1,-1,1)
cont=replace(cont,"$$sx_fengex1$","|")
cont=replace_huanhang_huanyuan(cont)
replace_asp_huanyuan=cont
end function
function replace_when_save(aaaaaa)
'防止与asp代码段的结束符冲突而在dreamweaver里编辑标签时异常,且script优先级大于textarea
aaaaaa=replace(aaaaaa,"</s"&"cript>","$----不要改本处----tempit----$/s"&"cript>",1,-1,1)
'script优先级大于textarea
aaaaaa=replace(aaaaaa,"<s"&"cript","$----不要改本处----tempit----$s"&"cript",1,-1,1)
aaaaaa=replace(aaaaaa,"$-$textarea","<textarea",1,-1,1)
aaaaaa=replace(aaaaaa,"$-$/textarea$-$","</textarea>",1,-1,1)
aaaaaa=replace(aaaaaa,"$--ned_不要改本处---zhushi--$","<!--",1,-1,1)
replace_when_save=aaaaaa
end function
function replace_when_complie(aaaaaa)
aaaaaa=replace(aaaaaa,"$-$textarea","<textarea",1,-1,1)
aaaaaa=replace(aaaaaa,"$-$/textarea$-$","</textarea>",1,-1,1)
aaaaaa=replace(aaaaaa,"$----不要改本处----tempit----$/s"&"cript>","</s"&"cript>",1,-1,1)
aaaaaa=replace(aaaaaa,"$----不要改本处----tempit----$s"&"cript","<s"&"cript",1,-1,1)
aaaaaa=replace(aaaaaa,"$--ned_不要改本处---zhushi--$","<!--",1,-1,1)
aaaaaa=replace(aaaaaa,"$$sx_zscrpt_endx$","</s"&"cript>",1,-1,1)
replace_when_complie=aaaaaa
end function
function replace_asp_huanyuan_no_s_plit(cont)
cont=replace(cont,"$$sx_aspcodex_startx1$",chr(60)&chr(37))
cont=replace(cont,"$$sx_aspcodex_endx1$",chr(37)&chr(62))
'防止与asp代码段的结束符冲突而在dreamweaver里编辑标签时异常,且script优先级大于textarea
cont=replace(cont,"</s"&"cript>","$----不要改本处----tempit----$/s"&"cript>",1,-1,1)
'script优先级大于textarea
cont=replace(cont,"<s"&"cript","$----不要改本处----tempit----$s"&"cript",1,-1,1)
cont=replace(cont,"<!--","$--ned_不要改本处---zhushi--$",1,-1,1)
'huanyuan用于显示，为了防止冲突,故以下把</textarea替换为$-$/textarea$-$之类
cont=replace(cont,"<textarea","$-$textarea",1,-1,1)
cont=replace(cont,"</textarea>","$-$/textarea$-$",1,-1,1)
cont=replace_huanhang_huanyuan(cont)
replace_asp_huanyuan_no_s_plit=cont
end function
function replace_huanhang_huanyuan(cont)
cont=replace(cont,"$$sx_aspcodex_huanhang$",vbcrlf)
replace_huanhang_huanyuan=cont
end function
function replace_xurl(cont)
'session(CacheTempx&"skeyyyqa")=request("data1")
'session(CacheTempx&"tkeyyyqa")=request("data2")
'session(CacheTempx&"ok")="1"
'if session(CacheTempx&"ok")="" then error
cont=replace(cont,"&","-sx_newdsoftxx123xxs_nagehao1-")
cont=replace(cont,"%","-sx_newdsoftxx1231xxs_nagehao2-")
cont=replace(cont,chr(34),"-sx_newdsoftxx12wxxs_nagehao3-")
cont=replace(cont,"#","-sx_newdsoftxx12wxxs_nagehao4-")
cont=replace(cont,"$","-sx_newdsoftxx12wxxs_nagehao5-")
cont=replace(cont,"/","-sx_newdsoftxx12wxxs_nagehao6-")
cont=replace(cont,"\","-sx_newdsoftxx12wxxs_nagehao7-")
cont=replace(cont,":","-sx_newdsoftxx12wxxs_nagehao8-")
cont=replace(cont,"?","-sx_newdsoftxx12wxxs_nagehao9-")
replace_xurl=cont
end function
function replace_url_huanyuan(cont)
'session(CacheTempx&"skeyyyqa")=request("data1")
'session(CacheTempx&"tkeyyyqa")=request("data2")
'session(CacheTempx&"ok")="1"
'if session(CacheTempx&"ok")="" then error
cont=replace(cont,"-sx_newdsoftxx123xxs_nagehao1-","&")
cont=replace(cont,"-sx_newdsoftxx1231xxs_nagehao2-","%")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao3-",chr(34))
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao4-","#")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao5-","$")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao6-","/")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao7-","\")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao8-",":")
cont=replace(cont,"-sx_newdsoftxx12wxxs_nagehao9-","?")
replace_url_huanyuan=cont
end function
function get_info_array_from_label_file_content(dddd)
err1=0
if instr(1,dddd,chr(60)&chr(37)&"'$start_ext_newDsoft",1)=0 or instr(1,dddd,"'$end_ext_newDsoft"&chr(37)&chr(62),1)=0 then
err1=1
nd1_label_type=""
nd1_l_name=""
nd1_label_sql=""
nd1_label_params=""
nd1_label_fenye_num=""
nd1_label_beizhu=""
nd1_other_params=""
nd1_is_sys_label=""
nd1_label_code=""
else
sss1=mid(dddd,instr(1,dddd,chr(60)&chr(37)&"'$start_ext_newDsoft",1)+22,instr(1,dddd,"'$end_ext_newDsoft"&chr(37)&chr(62),1)-(instr(1,dddd,chr(60)&chr(37)&"'$start_ext_newDsoft",1)+22))
if instr(1,sss1,"'$newDsoft_label_type$:",1)<>0 then
nd1_label_type=trim(mid(sss1,instr(1,sss1,"'$newDsoft_label_type$:",1)+23,instr(1,sss1,"$end_newDsoft_label_type$",1)-(instr(1,sss1,"'$newDsoft_label_type$:",1)+23)))
else
nd1_label_type=""
end if
if instr(1,sss1,"'$newDsoft_label_name$:",1)<>0 then
nd1_l_name=mid(sss1,instr(1,sss1,"'$newDsoft_label_name$:",1)+23,instr(1,sss1,"$end_newDsoft_label_name$",1)-(instr(1,sss1,"'$newDsoft_label_name$:",1)+23))
else
nd1_l_name=""
end if
if instr(1,sss1,"'$newDsoft_label_sql$:",1)<>0 then
nd1_label_sql=mid(sss1,instr(1,sss1,"'$newDsoft_label_sql$:",1)+22,instr(1,sss1,"$end_newDsoft_label_sql$",1)-(instr(1,sss1,"'$newDsoft_label_sql$:",1)+22))
nd1_label_sql=replace_huanhang_huanyuan(nd1_label_sql)
else
nd1_label_sql=""
end if
if instr(1,sss1,"'$newDsoft_label_params$:",1)<>0 then
nd1_label_params=mid(sss1,instr(1,sss1,"'$newDsoft_label_params$:",1)+25,instr(1,sss1,"$end_newDsoft_label_params$",1)-(instr(1,sss1,"'$newDsoft_label_params$:",1)+25))
nd1_label_params=replace_huanhang_huanyuan(nd1_label_params)
else
nd1_label_params=""
end if
if instr(1,sss1,"'$newDsoft_label_fenye_num$:",1)<>0 then
nd1_label_fenye_num=mid(sss1,instr(1,sss1,"'$newDsoft_label_fenye_num$:",1)+28,instr(1,sss1,"$end_newDsoft_label_fenye_num$",1)-(instr(1,sss1,"'$newDsoft_label_fenye_num$:",1)+28))
else
nd1_label_fenye_num=""
end if
if instr(1,sss1,"'$newDsoft_label_beizhu$:",1)<>0 then
nd1_label_beizhu=mid(sss1,instr(1,sss1,"'$newDsoft_label_beizhu$:",1)+25,instr(1,sss1,"$end_newDsoft_label_beizhu$",1)-(instr(1,sss1,"'$newDsoft_label_beizhu$:",1)+25))
nd1_label_beizhu=replace_huanhang_huanyuan(nd1_label_beizhu)
else
nd1_label_beizhu=""
end if
if instr(1,sss1,"'$newDsoft_other_params$:",1)<>0 then
nd1_other_params=mid(sss1,instr(1,sss1,"'$newDsoft_other_params$:",1)+25,instr(1,sss1,"$end_newDsoft_other_params$",1)-(instr(1,sss1,"'$newDsoft_other_params$:",1)+25))
nd1_other_params=replace_asp_huanyuan_no_s_plit(nd1_other_params)
else
nd1_other_params=""
end if
if instr(1,sss1,"'$newDsoft_is_sys_label$:",1)<>0 then
nd1_is_sys_label=mid(sss1,instr(1,sss1,"'$newDsoft_is_sys_label$:",1)+25,instr(1,sss1,"$end_newDsoft_is_sys_label$",1)-(instr(1,sss1,"'$newDsoft_is_sys_label$:",1)+25))
else
nd1_is_sys_label=""
end if
nd1_label_code=mid(dddd,instr(1,dddd,"'$end_ext_newDsoft"&chr(37)&chr(62),1)+20,len(dddd)-(instr(1,dddd,"'$end_ext_newDsoft"&chr(37)&chr(62),1)+20)+1)
'response.write "type:"&nd1_label_type&"<br>"
'response.write "name:"&nd1_l_name&"<br>"
'response.write "sql:"&nd1_label_sql&"<br>"
'response.write "params:"&nd1_label_params&"<br>"
'response.write "fenye:"&nd1_label_fenye_num&"<br>"
'response.write "beizhu:"&nd1_label_beizhu&"<br>"
'response.write "other_params:"&nd1_other_params&"<br>"
'response.write "is_sys:"&nd1_is_sys_label&"<br>"
'response.write nd1_label_code
end if
end function
'=server.htmlencode(replace(replace(rs("h_content"),"<br>",chr(10)),"<BR>",chr(10)))
'=Server.HTMLEncode(TemplateFromFileContent)
'Public Function HTMLEncode_nd(fString)
'call HTMLEncode(fString) '系统的HTMLEncode，但是系统的HTMLEncode不支持中文
'End Function
Public Function HTMLEncode_nd(fString)
If Not IsNull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
HTMLEncode_nd = fString
End If
End Function
Public Function HTMLCode(fString)
If Not IsNull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
'fString = Replace(fString, " "," ")
fString = Replace(fString, """, CHR(34))
fString = Replace(fString, "'", CHR(39))
fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10))
fString = Replace(fString, "<BR> ", CHR(10))
HTMLCode = fString
End If
End Function
Public Function getUrlEncodel(byVal Url)
Dim i,code
getUrlEncodel=""
If Trim(Url)="" Then Exit Function
For i=1 To Len(Url)
code=Asc(Mid(Url,i,1))
If code<0 Then code = code + 65536
If code>255 Then
getUrlEncodel=getUrlEncodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
Else
getUrlEncodel=getUrlEncodel&Mid(Url,i,1)
End If
Next
End Function
Public Function Furl(url)
Furl=Replace(url," ","%20",1,-1,1)
Furl=getUrlEncodel(Furl)
End Function
Function ClearHtmlTages(reString)
Dim Re
Dim Str:Str=reString
IF Not isnull(Str) Then
Set Re=New RegExp
Re.IgnoreCase =True
Re.Global=True
Re.Pattern="<(.[^>]*)>"
Str=Re.Replace(Str, "")
Set Re=Nothing
Str = replace(Str, ">", ">")
Str = replace(Str, "<", "<")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(9), "    ")
Str = Replace(Str, CHR(34), """)
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(13), "")
'Str = Server.Htmlencode(Str)
End IF
ClearHtmlTages = Str
End Function
Public Function Html2Ubb(ByVal strContent, ByVal sRemoveCode)
On Error Resume Next
If Len(strContent) > 0 Then
Dim ArrayCodes
Dim re
Set re = New RegExp
If Len(sRemoveCode) < 21 Then sRemoveCode = "1|1|0|0|0|0|0|0|0|0|0|0"
ArrayCodes = Split(sRemoveCode, "|")
re.IgnoreCase = True
re.Global = True
'--清除script脚本
If CInt(ArrayCodes(0)) = 1 Then
re.Pattern = "(<s+cript(.+?)<\/s+cript>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有iframe框架
If CInt(ArrayCodes(1)) = 1 Then
re.Pattern = "(<iframe(.+?)<\/iframe>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有object对象
If CInt(ArrayCodes(2)) = 1 Then
re.Pattern = "(<object(.+?)<\/object>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有java applet
If CInt(ArrayCodes(3)) = 1 Then
re.Pattern = "(<applet(.+?)<\/applet>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有div标签
If CInt(ArrayCodes(4)) = 1 Then
re.Pattern = "(<DIV>)|(<DIV(.+?)>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/DIV>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有font标签
If CInt(ArrayCodes(5)) = 1 Then
re.Pattern = "(<FONT>)|(<FONT(.+?)>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/FONT>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有span标签
If CInt(ArrayCodes(6)) = 1 Then
re.Pattern = "(<SPAN>)|(<SPAN(.+?)>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/SPAN>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有A标签
If CInt(ArrayCodes(7)) = 1 Then
re.Pattern = "(<A>)|(<A(.+?)>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/A>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有img标签
If CInt(ArrayCodes(8)) = 1 Then
re.Pattern = "(<IMG(.+?)>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有FORM标签
If CInt(ArrayCodes(9)) = 1 Then
re.Pattern = "(<FORM>)|(<FORM(.+?)>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/FORM>)"
strContent = re.Replace(strContent, "")
End If
'--清除所有HTML标签
If CInt(ArrayCodes(10)) = 1 Then
re.Pattern = "<(.[^>]*)>"
strContent = re.Replace(strContent, "")
End If
re.Pattern = "(" & Chr(8) & "|" & Chr(9) & "|" & Chr(10) & "|" & Chr(13) & ")"
strContent = re.Replace(strContent, vbNullString)
re.Pattern = "(<!--(.+?)-->)"
strContent = re.Replace(strContent, vbNullString)
re.Pattern = "(<TBODY>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<\/TBODY>)"
strContent = re.Replace(strContent, "")
re.Pattern = "(<" & Chr(37) & ")"
strContent = re.Replace(strContent, "<%")
re.Pattern = "(" & Chr(37) & ">)"
strContent = re.Replace(strContent, "%>")
Set re = Nothing
Html2Ubb = strContent
Else
Html2Ubb = ""
End If
Exit Function
End Function
function replace_textare_for_editor(LabelContent)
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
'解决文本框重复问题
regEx.Pattern = "\<textarea([^\>]{0,})(\>)"
LabelContent = regEx.Replace(LabelContent, "[$textarea$1]")
regEx.Pattern = "(\<\/textarea\>)"
LabelContent = regEx.Replace(LabelContent, "[$/textarea]")
LabelContent=replace(LabelContent,"<",chr(60))
LabelContent=replace(LabelContent,">",chr(62))
replace_textare_for_editor=LabelContent
' EditLabelContent = Replace(EditLabelContent, "<!--{$", "{$")
'EditLabelContent = Replace(EditLabelContent, "}-->", "}")
end function
function huanyuan_textare_for_editor(LabelContent)
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
'解决文本框重复问题
regEx.Pattern = "\[\$textarea([^\]]{0,})(\])"
LabelContent = regEx.Replace(LabelContent, "<textarea$1>")
regEx.Pattern = "(\[\$\/textarea\])"
LabelContent = regEx.Replace(LabelContent, "</textarea>")
huanyuan_textare_for_editor=LabelContent
end function
Public Function Re_Replace(str,retxt,replacetxt)
retxt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(retxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\.")
'replacetxt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(replacetxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\.")
Set Re = New RegExp
Re.IgnoreCase = True
Re.Global = True
Re.Pattern = retxt
Re_Replace = Re.Replace(str,replacetxt)
Set Re = Nothing
End Function
'替换标签参数的引用为标签参数的具体值
function repla_par(code22a,stra,a)
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "(\$xxvar\$"&stra&")([^a-zA-Z0-9\_]|$)"
aContent = regEx.Replace(code22a,"@1233newdsoft2145ruandingyuan6654@"&"$2")
'先经过@1233newdsoft2145ruandingyuan6654@ 是因为a里可能含$,与上面的"$2"相冲突
aContent=replace(aContent,"@1233newdsoft2145ruandingyuan6654@",a)
repla_par=aContent
end function
function replace_label_for_editor(LabelContent)
'图片替换JS
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "(\<Script)([\s\S]*?)(\<\/Script\>)"
Set Matches = regEx.Execute(EditLabelContent)
For Each Match In Matches
strTemp = Replace(Match.value, "<", "[!")
strTemp = Replace(strTemp, ">", "!]")
strTemp = Replace(strTemp, "'", """")
strTemp = "<IMG alt='#" & strTemp & "#' src=""" & InstallDir & "editor/images/jscript.gif"" border=0 $>"
EditLabelContent = Replace(EditLabelContent, Match.value, strTemp)
Next
'图片替换超级标签
regEx.Pattern = "(\{\$Gerticle|\{\$GetAeList|\{\$GetcArticle|\{\$GetPicSoft|\{\$GList|\{\$GetSlSoft|\{\$GetPhoto|\{\$Getist|\{\$GetSlioto|\{\$Goduct|\{\$GctList|\{\$Getoduct)\((.*?)\)\}"
EditLabelContent = regEx.Replace(EditLabelContent, "<IMG src=""" & InstallDir & "editor/images/ltel.gif"" border=0 zzz='$1($2)}'>")
end function
have_label=0
function field_name_to_f_num(name1)
sqlzz=mid(sqlxxx1112,instr(1,sqlxxx1112,"select ",1)+7,(instr(1,sqlxxx1112," from ",1)-1)-(instr(1,sqlxxx1112,"select ",1)+7)+1)
sqlzzarr=split(sqlzz,",")
eee1111i=""
for iww1=0 to ubound(sqlzzarr)
if lcase(trim(cstr(sqlzzarr(iww1))))=lcase(trim(cstr(name1))) then
eee1111i=iww1
exit for
end if
next
field_name_to_f_num=eee1111i
end function
'如替换$fmt(0,"num","html")这样的系统标签
function sys_replace_fmt(LabelContent11)
InfoTempMatch=LabelContent11
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "\{\$fmt\((.*?)\)\}"
Set MatchesInfo = regEx.Execute(InfoTempMatch)
For Each Match2 In MatchesInfo
have_label=1
FieldTemp = Match2.Value
FieldArry = Split(Match2.SubMatches(0), ",")
If UBound(FieldArry) > 1 Then
Select Case FieldArry(1)
Case "Text"
FieldTempText ="sqlxxx1112="&chr(34)&sqlxxx1112&chr(34)&":rsxxx1112="&chr(34)&rsxxx1112&chr(34)&":wewewe=cstr(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))&"&chr(34)&chr(34)
If FieldArry(2) = 0 Then
Select Case FieldArry(3)
Case 1
FieldTempText = FieldTempText & ":response.write Replace(cstr(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))&"&chr(34)&chr(34)&", "&chr(34)&"<"&chr(34)&", "&chr(34)&"<"&chr(34)&")"
Case 2
FieldTempText = FieldTempText & ":response.write nohtml(cstr(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))&"&chr(34)&chr(34)&")"
Case Else
FieldTempText = FieldTempText &":response.write cstr(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))&"&chr(34)&chr(34)
End Select
Else
Select Case FieldArry(3)
Case 1
If FieldArry(4) = 0 Then
FieldTempText = FieldTempText & ":response.write GetSubStr(Replace(wewewe, "&chr(34)&"<"&chr(34)&", "&chr(34)&"<"&chr(34)&"),"&FieldArry(2)&", True)"
Else
FieldTempText = FieldTempText & ":response.write GetSubStr(Replace(wewewe, "&chr(34)&"<"&chr(34)&", "&chr(34)&"<"&chr(34)&"), "&FieldArry(2)&", False)"
End If
Case 2
If FieldArry(4) = 0 Then
FieldTempText = FieldTempText & ":response.write GetSubStr(nohtml(wewewe), "&FieldArry(2)&", True)"
Else
FieldTempText = FieldTempText &":response.write GetSubStr(nohtml(wewewe), "&FieldArry(2)&", False)"
End If
Case Else
If FieldArry(4) = 0 Then
FieldTempText = FieldTempText &":response.write GetSubStr(wewewe, "&FieldArry(2)&", True)"
Else
FieldTempText = FieldTempText & ":response.write GetSubStr(wewewe, "&FieldArry(2)&", False)"
End If
End Select
End If
Case "Num"
FieldTempText ="sqlxxx1112="&chr(34)&sqlxxx1112&chr(34)&":rsxxx1112="&chr(34)&rsxxx1112&chr(34)&""
FieldTempText = FieldTempText &":call isnnum(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))"
FieldTempText = FieldTempText & ":if isnnn=0 then response.write "&chr(34)&"值格式错误"&chr(34)
Select Case FieldArry(2)
Case 0
If FieldArry(3) = "0" Then
FieldTempText = FieldTempText & " :end if:if isnnn=1 then response.write Int(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))"
Else
FieldTempText = FieldTempText & ":end if:if isnnn=1 then response.write String(Int(get_rs_value("&field_name_to_f_num(FieldArry(0))&")), "&FieldArry(3)&")"
End If
Case 1
FieldTempText = FieldTempText & ":end if:if isnnn=1 then response.write FormatNumber(get_rs_value("&field_name_to_f_num(FieldArry(0))&"), "&FieldArry(3)&")"
Case 2
FieldTempText = FieldTempText & ":end if:if isnnn=1 then response.write FormatPercent(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))"
End Select
Case "Time"
Dim temptime, temptimetext
FieldTempText ="sqlxxx1112="&chr(34)&sqlxxx1112&chr(34)&":rsxxx1112="&chr(34)&rsxxx1112&chr(34)&""
FieldTempText = FieldTempText &":call isddat(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))"
FieldTempText = FieldTempText & ":if isnnn=0 then response.write "&chr(34)&"日期格式错误"&chr(34)
FieldTempText = FieldTempText & " :end if:if isnnn<>0 then temptime=get_rs_value("&field_name_to_f_num(FieldArry(0))&")"
Select Case FieldArry(2)
Case 0
FieldTempText = FieldTempText & " :end if:if isnnn<>0 then www123ww123es=Replace(Replace(Replace(Replace(Replace(Replace("&chr(34)&FieldArry(3)&chr(34)&", "&chr(34)&"{year}"&chr(34)&", Year(temptime)), "&chr(34)&"{month}"&chr(34)&", Month(temptime)), "&chr(34)&"{day}"&chr(34)&", Day(temptime)), "&chr(34)&"{Hour}"&chr(34)&", Hour(temptime)), "&chr(34)&"{Minute}"&chr(34)&", Minute(temptime)), "&chr(34)&"{Second}"&chr(34)&", Second(temptime)):response.write www123ww123es"
Case 3
FieldTempText = FieldTempText & " :end if:if isnnn=1 then response.write FormatDateTime(temptime, "&chr(34)&FieldArry(3)&chr(34)&")"
End Select
Case "yn"
FieldTempText ="sqlxxx1112="&chr(34)&sqlxxx1112&chr(34)&":rsxxx1112="&chr(34)&rsxxx1112&chr(34)&""
FieldTempText = FieldTempText &":call isyn(get_rs_value("&field_name_to_f_num(FieldArry(0))&"))"
FieldTempText = FieldTempText & ":if isnnn=1 then response.write "&chr(34)&FieldArry(2)&chr(34)
FieldTempText = FieldTempText & " end if:if isnnn=0 then response.write "&chr(34)&FieldArry(3)&chr(34)
FieldTempText = FieldTempText & " :end if:if isnnn=9999 then response.write "&chr(34)&"不是布尔值"&chr(34)
Case Else
FieldTempText = ""
End Select
Else
FieldTempText = ""
End If
If Trim(FieldTempText & "") = "" Then
InfoTempMatch = Replace(InfoTempMatch, FieldTemp, "")
Else
InfoTempMatch = Replace(InfoTempMatch, FieldTemp, chr(60)&chr(37)&FieldTempText&chr(37)&chr(62))
End If
Next
sys_replace_fmt=InfoTempMatch
end function
function find_other_param(z_name,nd1_other_params)
rst2=""
if trim(nd1_other_params)<>"" and instr(1,nd1_other_params,":",1)<>0 then
other_params=split(nd1_other_params,"|")
for igggg=0 to ubound(other_params)
sss11=split(other_params(igggg),":")
sss11a=sss11(0)
sss11b=sss11(1)
if cstr(sss11a)=cstr(z_name) then
rst2=sss11b
exit for
end if
next
end if
rst2=replace(rst2,"$$sx_fengex1$","|")
rst2=replace(rst2,"$$sx_maohao$",":")
find_other_param=rst2
end function
function replace_di2ji_canshuo(code221,dd,dddd)
if isarray(dd)<>true then
can_shuo_num=0
else
can_shuo_num=ubound(dd)+1
end if
if isarray(dddd)<>true then
ssshjk=-1
else
ssshjk=ubound(dddd)
end if
if (can_shuo_num-1)<>ssshjk then
replace_di2ji_canshuo=code221
exit function
end if
for yir=0 to (can_shuo_num-1)
a=trim(dd(yir))
can_shuo_name=trim(dddd(yir))
'response.write "$xxvar$"&can_shuo_name&"<br>"
code221=repla_par(code221,trim(can_shuo_name),a)
next
replace_di2ji_canshuo=code221
end function
Public Function SaveXMLDocument_newindexc(ByVal strXMLFile,ByVal strXMLDom,ByVal is_cms)
SaveXMLDocument_newindexc = False
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If oXMLDom.LoadXml(strXMLDom) Then
oXMLDom.documentElement.selectSingleNode("all_web_file_name_and_type_config").text=w_files_config
if is_cms=1 then
oXMLDom.documentElement.selectSingleNode("template_type_qiye_or_cms").text="cms"
else
oXMLDom.documentElement.selectSingleNode("template_type_qiye_or_cms").text="qiye"
end if
oXMLDom.save strXMLFile
SaveXMLDocument_newindexc = True
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
SaveXMLDocument_newindexc = False
End If
End Function
function replace_ads(str)
if trim(str)="" then
replace_ads=str
exit function
end if
set rs11ssc=server.CreateObject("adodb.recordset")
rs11ssc.open "select * from ND_sys where [type]='ads_label'",conn,1,1
if not rs11ssc.eof then
sdscvsd=split(rs11ssc("data"),"$ms$ndsoft1314$")
for isoiso=0 to ubound(sdscvsd)
if instr(1,lcase(str),lcase("{$adscode"&cstr(isoiso+1)&"$}"),1)<>0 then
str=replace(str,"{$adscode"&cstr(isoiso+1)&"$}",sdscvsd(isoiso),1,-1,1)
have_label=1
end if
next
end if
replace_ads=str
end function
function replace_webfiles_names(str,is_cms)
if trim(str)="" then
replace_webfiles_names=str
exit function
end if
set rs112=server.CreateObject("adodb.recordset")
if is_cms=1 then
rs112.open "select * from ND_templates_folder_reg where is_default_template=true",conn,1,1
else
rs112.open "select * from ND_templates_folder_reg_qiye where is_default_template=true",conn,1,1
end if
if rs112.eof then
replace_webfiles_names=str
exit function
else
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../../"&ppath&iscrtfile
use_http_url=0
use_http_post=0
set fileaw=new Cls_FSO
set filebw=new DosAsp
if fileaw.ReportFileStatus(server.mappath(scrt_ff))=-1 then
'模板目录下不存在"&iscrtfile&"安装脚本文件
sconts=loadfile("../../inc/"&w_web_config_template)
call SaveXMLDocument_newindexc(scrt_ff,sconts,is_cms)
scrt_ff="../../"&ppath&w_files_config
sconts=loadfile("../../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
else
'模板目录下存在"&iscrtfile&"安装脚本文件
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_fff="../../"&ppath&xm_d_c
if fileaw.ReportFileStatus(server.mappath(scrt_fff))=-1 then
scrt_ff="../../"&ppath&xm_d_c
sconts=loadfile("../../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
end if
end if
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../../"&ppath&iscrtfile
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_ff="../../"&ppath&xm_d_c
set aasc=ReadXMLDocument_nodes(scrt_ff,"files/file_reg")
for aiaa=0 to aasc.length-1
aassaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filetype").text))
bbssbb=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filename").text))
'ccsscc=trim(rep_xml_br(aasc(aiaa).selectSingleNode("to_html_filename").text))
if instr(1,lcase(str),lcase("$page$"&aassaa&"$"),1)<>0 then
str=replace(str,"$page$"&aassaa&"$",bbssbb,1,-1,1)
have_label=1
end if
next
replace_webfiles_names=str
end if
end function
function leftt(aaaa1,ln)
if len(aaaa1)>=ln then
leftt=left(aaaa1,ln)
else
leftt=aaaa1
end if
end function
function replace_label_main(content,filepath1)
if trim(content)="" then
replace_label_main=content
exit function
end if
glbal_page_splt_str=""
content_yuan=content
nd_ggbol_funstr11conn=loadfile(complie_dir&"D_asp_code_str_for_complie_conn.asp")
nd_ggbol_funstr1a=loadfile(complie_dir&"D_asp_code_str_a.asp")
nd_ggbol_funstr2b=loadfile(complie_dir&"D_asp_code_str_for_complie_b.asp")
nd_ggbol_funstr3c=loadfile(complie_dir&"D_asp_code_str_for_complie_c.asp")
nd_ggbol_funstr2d=loadfile(complie_dir&"D_asp_code_str_for_complie_d.asp")
nd_ggbol_funstr2e=loadfile(complie_dir&"D_asp_code_str_for_complie_e.asp")
set rs441122=server.CreateObject("adodb.recordset")
sql="select * from [ND_templates_error_label_list_cache]"
rs441122.open sql,conn,1,3
set Rs44=server.CreateObject("adodb.recordset")
sql="select * from [ND_label_cache] order by id desc"
Rs44.open sql,conn,1,1
'------v2 code------------------------------------------
have_biaozi=1
'------v3 1----
org_pos_to_find=1
'------end v3 1----
do while have_biaozi=1
have_biaozi=0
for tttstaa=1 to len(content)
bzposs=instr(org_pos_to_find,content,"{$$",1)
if bzposs<>0 then
'------v3 2----
org_pos_to_find=bzposs
'------end v3 2----
find_pypos=-123
for pianyi_pos=0 to 200
if mid(content,bzposs+3+pianyi_pos,1)="(" or mid(content,bzposs+3+pianyi_pos,1)="}" then
find_pypos=bzposs+3+pianyi_pos
exit for
end if
next
if find_pypos=-123 then
org_pos_to_find=bzposs+3
else
fd_lb_namea=lcase(mid(content,bzposs+3,find_pypos-(bzposs+3)))
sql="select * from [ND_label_cache] where lcase(label_name)='"&fd_lb_namea&"'"
Rs44.close
Rs44.open sql,conn,1,1
if Rs44.eof then
org_pos_to_find=bzposs+3
else
have_biaozi=1
exit for
end if
end if
else
exit do
end if
next
if have_biaozi=0 then exit do
'------end v2 code--------------------------------------
yy=0
y=0
'----------------------------------
ltype=rs44("label_type")
lname=rs44("label_name")
codeb=rs44("label_code")
lsql=rs44("label_sql")
lsql=trim(lsql)
lpath=rs44("label_full_path_name")
lparams=rs44("label_params")
label_fenye_num=rs44("label_fenye_num")
label_beizhu=rs44("label_beizhu")
is_sys_label=rs44("is_sys_label")
label_other_params=replace_when_complie(rs44("label_other_params"))
'判断有效标签开始
if trim(lname)<>"" and trim(ltype)<>"" then
lparams33fmt=""
lparams33=""
have_lprams=0
if lparams<>"" then
have_lprams=1
lparams2=split(lparams,"|")
for idd=0 to ubound(lparams2)
sssdddd=split(lparams2(idd),",")
lparams33=lparams33&sssdddd(0)
'-----------------------------v4
if ubound(sssdddd)<2 then
lparams33fmt=lparams33fmt&"2"
else
lparams33fmt=lparams33fmt&sssdddd(2)
end if
'-----------------------------v4
if idd<>ubound(lparams2) then
lparams33=lparams33&","
'-----------------------------v4
lparams33fmt=lparams33fmt&","
'-----------------------------v4
end if
next
end if
dd=lparams33
dddsql=dd
bb="$$"&lname
code=codeb
y=1
if lparams33="" then
can_shuo_num=0
else
dddd=split(lparams33,",")
can_shuo_num=ubound(dddd)+1
end if
err1=0
err2=0
count=0
if y=0 and yy=0 then err1=1
'replace( 后的,1,-1,1)指定不区分大小写
'------v3 3----
'do while (err1=0 and (instr(1,content,"{"&bb&"(",1)<>0 or instr(1,content,"{"&bb&"}",1)<>0))
do while (err1=0 and (instr(org_pos_to_find,content,"{"&bb&"(",1)<>0 or instr(org_pos_to_find,content,"{"&bb&"}",1)<>0))
'------v3 3----
'------------v1.2------------------
call nd_process_sleep(nd_sleep_x_times_cmple)
'------------v1.2------------------
'--------------v3 4b--------------------
err_chr_quot=0
'--------------v3 4b--------------------
'----------------------------------------------------------------------------------------------------------------------
'以下一定要放在最前面即funstr11&funstr1&content而 不是第一个标签前，以免除标签外，页面里的asp代码也有调用 conn对象的
'以下一定要放在最前面即funstr11&funstr1&content而 不是第一个标签前，以免除标签外，页面里的asp代码也有调用 conn对象的
funstr11=nd_ggbol_funstr11conn
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$db_str$",main_data_mdb)
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr1=nd_ggbol_funstr1a
funstr1=replace(funstr1,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if h_curfile=filepath1 and h_curfile<>"xxxfirstned" then
funstr1=" "
funstr11=""
else
content=funstr11&funstr1&content
h_curfile=filepath1
end if
'----------------------------------------------------------------------------------------------------------------------
ltype=rs44("label_type")
lname=rs44("label_name")
lsql=rs44("label_sql")
lpath=rs44("label_full_path_name")
lparams=rs44("label_params")
label_fenye_num=rs44("label_fenye_num")
label_beizhu=rs44("label_beizhu")
is_sys_label=rs44("is_sys_label")
label_other_params=replace_when_complie(rs44("label_other_params"))
code=codeb
mmmm=len(content)
pos=instr(1,content,"{"&bb,1)
'以下防止 如{$$n_class(1)}与{$$n_class_1}中$$n_class字符串类似而导致的冲突
if instr(1,content,"{"&bb&"(",1)<>0 then
pos=instr(1,content,"{"&bb&"(",1)
else
if instr(1,content,"{"&bb&"}",1)<>0 then
pos=instr(1,content,"{"&bb&"}",1)
end if
end if
have_lpram_shiji=0
abc=pos+len(bb)+1
if abc>mmmm then err2=1
if err2=0 then
if mid(content,abc,1)="(" then
i=abc
notfound=0
iii=i
have_lpram_shiji=1
yaofound=1
else
yaofound=0
end if
if yaofound=1 then
execute("aae11e1e11=sy"&"s_"&"u"&"r"&"l_"&"g"&"e"&"t")
execute("aae11e1e211=sy"&"s_u"&"r"&"l_"&"g"&"et"&"_b")
if cstr(aae11e1e11)<>cstr(aae11e1e211) or aae11e1e11="" or instr(1,aae11e1e11,"as"&"pcp"&"u",1)=0 then
status1=aaerweee1e11
end if
'针对{$$show_news({$$xxxw_a({$$edsda(1,2,22)})})}多层嵌套,可以编译嵌套层数未知的嵌套标签,还没考虑编译优先级问题,应该从里到外编译,因为这样参数好传递到外层标签:
'针对{$$show_news({$$xxxw_a({$$edsda(1,2,22)})})}多层嵌套,可以编译嵌套层数未知的嵌套标签,还没考虑编译优先级问题,应该从里到外编译,因为这样参数好传递到外层标签:
'针对{$$show_news({$$xxxw_a({$$edsda(1,2,22)})})}多层嵌套,可以编译嵌套层数未知的嵌套标签,还没考虑编译优先级问题,应该从里到外编译,因为这样参数好传递到外层标签:
cen=0
do while ( (not(mid(content,i,1)=")" and mid(content,i+1,1)="}")) and i<=mmmm and cen=0)
if ((i+2)<=mmmm) and mid(content,i,1)&mid(content,i+1,1)&mid(content,i+2,1)="{$$" then
cen=cen+1
end if
if mid(content,i,1)="}" then
cen=cen-1
end if
i=i+1
if i=mmmm then
notfound=1
err2=1
end if
loop
end if
ssbbbbssbs=""
if err2=0 then
if yaofound=1 then
bbb=mid(content,iii,(i-iii+1))
'bbb=replace(bbb,"(","")
'bbb=replace(bbb,")","")
bbb=left(bbb,len(bbb)-1)
bbb=right(bbb,len(bbb)-1)
'--------------v3 4a--------------------
if instr(1,bbb,""",1)<>0 then
err_chr_quot=1
end if
if instr(1,bbb,"&quot;",1)<>0 then
err_chr_quot=1
end if
'--------------v3 4a--------------------
ssbbbbssbs=bbb
'----------------------------------------------
if bbb="" then
ssbbbbssbs=""
in_can_shuo_num=0
else
dd=split(bbb,",")
'=++++++++++++++++++++++++start+++++++++++++++++++++++++++++++++++++++++++++++++++++
'----------------------------------
dd=split(bbb,",")
if isarray(dddd)<>true then
can_shuo_num22=0
else
can_shuo_num22=ubound(dddd)+1
end if
for yi22=0 to (can_shuo_num22-1)
if yi22>ubound(dd) then
a222="error"
else
a222=trim(dd(yi22))
end if
can_shuo_name=trim(dddd(yi22))
lsql=repla_par(lsql,trim(can_shuo_name),a222)
next
'response.write lsql&"<hr>"
'----------------------------------
'-------------------------------------------------------------------
haveda=1
for iiiiii=1 to 99
if haveda=0 then exit for
haveda=0
if instr(1,lcase(trim(lsql)),"$xx_var_asp$",1)<>0 then
haveda=1
fdpos=instr(1,lcase(trim(lsql)),"$xx_var_asp$",1)
starta=mid(lsql,1,fdpos-1)
fdi=len(lcase(trim(lsql)))+1
for llpi=fdpos+12 to len(lcase(trim(lsql)))
if mid(lsql,llpi,1)=" " or mid(lsql,llpi,1)=" " or mid(lsql,llpi,1)="," or mid(lsql,llpi,1)="%" or mid(lsql,llpi,1)="，" or mid(lsql,llpi,1)="'" or mid(lsql,llpi,1)=")" or mid(lsql,llpi,1)="]" then
fdi=llpi
exit for
end if
'-----------------
'if len(lcase(trim(lsql)))=llpi then
'fdi=len(lcase(trim(lsql)))+1
'exit for
'end if
'-----------------
next
bianliang=mid(lsql,fdpos+12,(fdi-(fdpos+12)))
if fdi=len(lcase(trim(lsql)))+1 then
enda=""
else
enda=mid(lsql,fdi,(len(lcase(trim(lsql)))-fdi)+1)
end if
lsql=starta&chr(34)&"&"&bianliang&"&"&chr(34)&enda
end if
next
haveda=1
for iiiiii=1 to 99
if haveda=0 then exit for
haveda=0
if instr(1,lcase(trim(lsql)),"$xx_request_asp$",1)<>0 then
haveda=1
fdpos=instr(1,lcase(trim(lsql)),"$xx_request_asp$",1)
starta=mid(lsql,1,fdpos-1)
fdi=len(lcase(trim(lsql)))+1
for llpi=fdpos+16 to len(lcase(trim(lsql)))
if mid(lsql,llpi,1)=" " or mid(lsql,llpi,1)=" " or mid(lsql,llpi,1)="," or mid(lsql,llpi,1)="%" or mid(lsql,llpi,1)="，" or mid(lsql,llpi,1)="'" or mid(lsql,llpi,1)=")" or mid(lsql,llpi,1)="]" then
fdi=llpi
exit for
end if
'-----------------
'if len(lcase(trim(lsql)))=llpi then
'fdi=len(lcase(trim(lsql)))+1
'exit for
'end if
'-----------------
next
bianliang=mid(lsql,fdpos+16,(fdi-(fdpos+16)))
if fdi=len(lcase(trim(lsql)))+1 then
enda=""
else
enda=mid(lsql,fdi,(len(lcase(trim(lsql)))-fdi)+1)
end if
lsql=starta&chr(34)&"&request("&chr(34)&bianliang&chr(34)&")&"&chr(34)&enda
end if
next
'-------------------------------------------------------------------
'=++++++++++++++++end+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'---------v4
err2fmt=0
err2fmt_msg=""
'---------v4
'---------v4
lparams33fmtdddd=split(lparams33fmt,",")
'---------v4
in_can_shuo_num=ubound(dd)+1
if in_can_shuo_num=can_shuo_num and in_can_shuo_num<>0 then
for yi=0 to (in_can_shuo_num-1)
a=trim(dd(yi))
'---------v4
if cstr(lparams33fmtdddd(yi)&"")="1" then
a=trim(a)&""
'排除Article_id41这样的字符串要加引号外，其他非数字字符串可以不加引号而作为变量直接代入，和$xx_request_asp$XXXX，request(...),$xx_var_asp$之类也可以直接代入
if ( (left(a,1)<>"""" or right(a,1)<>"""") and leftt(lcase(a),8)<>"request(" and leftt(lcase(a),16)<>"$xx_request_asp$" and leftt(lcase(a),12)<>"$xx_var_asp$" and (instr(1,lcase(a),"_id",1)<>0 or isnumeric(a)=true) ) or a="""" then
err2fmt=1
err2fmt_msg=err2fmt_msg&"错误:此标签第"&cstr(yi+1)&"个标签参数值的两端必须加一对双引号包括住,或形如$xx_request_asp$XXXX与$xx_var_asp$XXXX; "
end if
end if
if cstr(lparams33fmtdddd(yi)&"")="2" then
a=trim(a)&""
'因为自定义sql里的where a='$xx_request_asp$aa'会被转为where a='"&$xx_request_asp$aa&"' ,所以不含双引号的参数允许使用$xx_request_asp$
'因为自定义sql里的where a='$xx_request_asp$aa'会被转为where a='"&$xx_request_asp$aa&"' ,所以不含双引号的参数允许使用$xx_request_asp$
'if instr(1,a,"""",1)<>0 or leftt(lcase(a),16)="$xx_request_asp$" or leftt(lcase(a),12)="$xx_var_asp$" then
if instr(1,a,"""",1)<>0 then
err2fmt=1
err2fmt_msg=err2fmt_msg&"错误:此标签第"&cstr(yi+1)&"个标签参数值必须不含双引号; "
end if
end if
if cstr(lparams33fmtdddd(yi)&"")="3" and leftt(lcase(a),8)<>"request(" and leftt(lcase(a),16)<>"$xx_request_asp$" and leftt(lcase(a),12)<>"$xx_var_asp$" then
aa=trim(a)&""
if aa="" then aa="aaa"
if isnumeric(aa)=false or (left(aa,1)="""" or right(aa,1)="""") then
err2fmt=1
err2fmt_msg=err2fmt_msg&"错误:此标签第"&cstr(yi+1)&"个标签参数值必须为不含双引号的纯数字; "
end if
end if
if (instr(1,lcase(a),"$xx_request_asp$",1)<>0 or instr(1,lcase(a),"$xx_var_asp$",1)<>0 or instr(1,lcase(a),"request(",1)<>0) and (left(a,1)="""" or right(a,1)="""") then
err2fmt=1
err2fmt_msg=err2fmt_msg&"错误:此标签第"&cstr(yi+1)&"个标签参数值含$xx_request_asp$XXXX或$xx_var_asp$XXXX之类.则不需要在参数值外面加双引号; "
end if
'---------v4
next
end if
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'以下一定要放在lsql替换$xxvar$a标签的后面
'对于参数里的$xx_var_asp$a,$xx_request_asp$b
for ppppppep=o to ubound(dd)
if instr(1,lcase(trim(dd(ppppppep))),"$xx_var_asp$",1)<>0 then
'replace( 的,1,-1,1)指定不区分大小写
dd(ppppppep)=replace(lcase(trim(dd(ppppppep))),"$xx_var_asp$","",1,-1,1)
end if
execute("aaee1e11=sy"&"s_"&"u"&"r"&"l_"&"g"&"e"&"t")
execute("aaee1e211=sy"&"s_u"&"r"&"l_g"&"et"&"_b")
if cstr(aaee1e11)<>cstr(aaee1e211) or aaee1e11="" or instr(1,aaee1e11,"as"&"pcp"&"u",1)=0 then
status1=aaerweee1e11
end if
if instr(1,lcase(trim(dd(ppppppep))),"$xx_request_asp$",1)<>0 then
dd(ppppppep)=replace(lcase(trim(dd(ppppppep))),"$xx_request_asp$","request("&chr(34),1,-1,1)
dd(ppppppep)=dd(ppppppep)&chr(34)&")"
end if
next
in_can_shuo_num=ubound(dd)+1
if in_can_shuo_num=can_shuo_num and in_can_shuo_num<>0 then
for yi=0 to (in_can_shuo_num-1)
a=trim(dd(yi))
can_shuo_name=trim(dddd(yi))
'response.write "$xxvar$"&can_shuo_name&"<br>"
code=repla_par(code,trim(can_shuo_name),a)
next
else
errstr="标签的参数个数不对"
err2=1
have_label=1
'response.write "in_can_shuo_num="&in_can_shuo_num&"<br>"&"label_can_shuo_num="&can_shuo_num
end if
end if
'----------------------------------------------
else
i=pos+len(bb)
end if
end if
code_ok=""
h_aaa=0
'==============start==========================================
if ltype="loop_label_two_loop" then
xxxx11=find_other_param("iffen",label_other_params)
xxxx22=find_other_param("di2xh_num",label_other_params)
xxxx22=replace_di2ji_canshuo(xxxx22,dd,dddd)
xxxx33=find_other_param("run_asp1",label_other_params)
xxxx33=replace_di2ji_canshuo(xxxx33,dd,dddd)
xxxx44=find_other_param("run_asp2",label_other_params)
xxxx44=replace_di2ji_canshuo(xxxx44,dd,dddd)
xxxx55=find_other_param("yi_ksdaima2",label_other_params)
xxxx55=replace_di2ji_canshuo(xxxx55,dd,dddd)
xxxx66=find_other_param("ksdaima2",label_other_params)
xxxx66=replace_di2ji_canshuo(xxxx66,dd,dddd)
xxxx77=find_other_param("jiesdaima2",label_other_params)
xxxx77=replace_di2ji_canshuo(xxxx77,dd,dddd)
xxxx88=find_other_param("yi_jiesdaima22",label_other_params)
xxxx88=replace_di2ji_canshuo(xxxx88,dd,dddd)
xxxx99=find_other_param("hhks",label_other_params)
xxxx99=replace_di2ji_canshuo(xxxx99,dd,dddd)
xxxxaa=find_other_param("hhend",label_other_params)
xxxxaa=replace_di2ji_canshuo(xxxxaa,dd,dddd)
xxxxbb=find_other_param("sql_run",label_other_params)
xxxxbb=replace_di2ji_canshuo(xxxxbb,dd,dddd)
xxxxrrrr=trim(find_other_param("rsname",label_other_params))
htmledxa=find_other_param("htmledxa",label_other_params)
if htmledxa="" then htmledxa="1"
htmledxax=clng(htmledxa)
if xxxxrrrr="" then xxxxrrrr="rs_x1"
xxxxrrrr=replace_di2ji_canshuo(xxxxrrrr,dd,dddd)
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数
funstr11=nd_ggbol_funstr11conn
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$db_str$",main_data_mdb)
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr1=nd_ggbol_funstr1a
funstr1=replace(funstr1,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if h_curfile=filepath1 and h_curfile<>"xxxfirstned" then
funstr1=" "
funstr11=""
else
h_curfile=filepath1
end if
label_fenye_num=replace_di2ji_canshuo(label_fenye_num,dd,dddd)
funstr2=nd_ggbol_funstr2b
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$yyyy$",xxxx22)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$sql$",lsql)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$per$",label_fenye_num)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$run1_asp$",xxxx33)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$run2_asp$",xxxx44)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di1_ks_html$",xxxx55)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di2_ks_html$",xxxx66)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$zhengwen$",code)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di2_jieshu_html$",xxxx77)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di1_jieshu_html$",xxxx88)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$iffen$",xxxx11)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$hhks$",xxxx99)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$hhend$",xxxxaa)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$run_sql$",xxxxbb)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rs_x$",xxxxrrrr)
'替换标签代码里的用户输入的$$xxxx_d_soft_complie$$rnd$
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr3=nd_ggbol_funstr3c
funstr3=replace(funstr3,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr3=replace(funstr3,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if cstr(xxxx11)<>"1" then funstr3=""
glbal_page_splt_str=glbal_page_splt_str&funstr3
code_ok=code_ok&funstr11&vbcrlf&funstr1&vbcrlf&funstr2
sqlxxx1112=lsql
rsxxx1112=xxxxrrrr
code_ok=sys_replace_fmt(code_ok)
end if
if ltype="loop_label_one_loop" then
xxxx11=find_other_param("iffen",label_other_params)
xxxx22=find_other_param("run_asp_1_1",label_other_params)
xxxx22=replace_di2ji_canshuo(xxxx22,dd,dddd)
xxxx22=replace_di2ji_canshuo(xxxx22,dd,dddd)
xxxx33=find_other_param("ksdaima",label_other_params)
xxxx33=replace_di2ji_canshuo(xxxx33,dd,dddd)
xxxx44=find_other_param("jiesdaima",label_other_params)
xxxx44=replace_di2ji_canshuo(xxxx44,dd,dddd)
xxxx99=find_other_param("hhks",label_other_params)
xxxx99=replace_di2ji_canshuo(xxxx99,dd,dddd)
xxxxaa=find_other_param("hhend",label_other_params)
xxxxaa=replace_di2ji_canshuo(xxxxaa,dd,dddd)
xxxxbb=find_other_param("sql_run",label_other_params)
xxxxbb=replace_di2ji_canshuo(xxxxbb,dd,dddd)
xxxxrrrr=trim(find_other_param("rsname",label_other_params))
htmledxa=find_other_param("htmledxa",label_other_params)
if htmledxa="" then htmledxa="1"
htmledxax=clng(htmledxa)
if xxxxrrrr="" then xxxxrrrr="rs_x2"
xxxxrrrr=replace_di2ji_canshuo(xxxxrrrr,dd,dddd)
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数
funstr11=nd_ggbol_funstr11conn
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$db_str$",main_data_mdb)
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr1=nd_ggbol_funstr1a
funstr1=replace(funstr1,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if h_curfile=filepath1 and h_curfile<>"xxxfirstned" then
funstr1=" "
funstr11=""
else
h_curfile=filepath1
end if
label_fenye_num=replace_di2ji_canshuo(label_fenye_num,dd,dddd)
funstr2=nd_ggbol_funstr2d
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$xxxx$",label_fenye_num)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$run1_asp$",xxxx22)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$sql$",lsql)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di1_ks_html$",xxxx33)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$zhengwen$",code)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$di1_jieshu_html$",xxxx44)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$iffen$",xxxx11)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$hhks$",xxxx99)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$hhend$",xxxxaa)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$run_sql$",xxxxbb)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rs_x$",xxxxrrrr)
'替换标签代码里的用户输入的$$xxxx_d_soft_complie$$rnd$
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr3=nd_ggbol_funstr3c
funstr3=replace(funstr3,"$$xxxx_d_soft_complie$$rnd$",rnddd)
funstr3=replace(funstr3,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if cstr(xxxx11)<>"1" then funstr3=""
glbal_page_splt_str=glbal_page_splt_str&funstr3
code_ok=code_ok&funstr11&vbcrlf&funstr1&vbcrlf&funstr2
sqlxxx1112=lsql
rsxxx1112=xxxxrrrr
code_ok=sys_replace_fmt(code_ok)
'response.write "<textarea cols=80 rows=26>"&code_ok&"</textarea>"
'response.end
end if
if ltype="dyn_content_label" then
htmledxa=find_other_param("htmledxa",label_other_params)
if htmledxa="" then htmledxa="1"
htmledxax=clng(htmledxa)
funstr11=nd_ggbol_funstr11conn
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$db_str$",main_data_mdb)
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr1=nd_ggbol_funstr1a
funstr1=replace(funstr1,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if h_curfile=filepath1 and h_curfile<>"xxxfirstned" then
funstr1=" "
funstr11=""
else
h_curfile=filepath1
end if
xxxxrrrr=trim(find_other_param("rsname",label_other_params))
if xxxxrrrr="" then xxxxrrrr="rs_x"
xxxxrrrr=replace_di2ji_canshuo(xxxxrrrr,dd,dddd)
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数
funstr2=nd_ggbol_funstr2e
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$sql$",lsql)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$zhengwen$",code)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rs_x$",xxxxrrrr)
'替换标签代码里的用户输入的$$xxxx_d_soft_complie$$rnd$
funstr2=replace(funstr2,"$$xxxx_d_soft_complie$$rnd$",rnddd)
code_ok=code_ok&funstr11&vbcrlf&funstr1&vbcrlf&funstr2
sqlxxx1112=lsql
rsxxx1112=xxxxrrrr
code_ok=sys_replace_fmt(code_ok)
end if
if ltype="asp_label" then
htmledxa=find_other_param("htmledxa",label_other_params)
if htmledxa="" then htmledxa="1"
htmledxax=clng(htmledxa)
funstr11=nd_ggbol_funstr11conn
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$db_str$",main_data_mdb)
funstr11=replace(funstr11,"$$xxxx_d_soft_complie$$conn$",nd_conn_var_str)
if h_curfile=filepath1 and h_curfile<>"xxxfirstned" then
funstr11=""
else
h_curfile=filepath1
end if
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数
'替换标签代码里的用户输入的$$xxxx_d_soft_complie$$rnd$
code=replace(code,"$$xxxx_d_soft_complie$$rnd$",rnddd)
code_ok=funstr11&vbcrlf&code
end if
'===========end=============================================
ok_rp=1
set rs4411=server.CreateObject("adodb.recordset")
sql="select * from [ND_label_cache] where label_name='"&trim(lname)&"'"
rs4411.open sql,conn,1,1
ok_rp=1
if rs4411.recordcount>1 then
'if instr(1,content,"{$$"&lname&"(",1)<>0 or instr(1,content,"{$$"&lname&"}",1)<>0 then
ok_rp=0
rs441122.addnew
rs441122("template_full_path_filename")=filepath1
rs441122("complie_status")="标签库有重名标签存在"
rs441122("error_label_name")=trim(lname)
nnnnear1=20
if instr(1,content_yuan,lname,1)=0 then
errssdtr="该标签嵌套在另一标签的标签正文代码里,无法确定其父标签的位置,该标签名字为"&lname
else
if (instr(1,content_yuan,lname,1)+len(lname)+nnnnear1)<mmmm then
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)+nnnnear1-1
else
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)-1
end if
if (instr(1,content_yuan,lname,1)-nnnnear1)>1 then
snnnnnnnd1=instr(1,content_yuan,lname,1)-nnnnear1
else
snnnnnnnd1=instr(1,content_yuan,lname,1)
end if
errssdtr=mid(content_yuan,snnnnnnnd1,ennnnnnnd1)
end if
rs441122("error_str_near")="..... <font color=red>"&errssdtr&"</font> ......"
rs441122.update
if pos<>1 then
aaa=mid(content,1,pos-1)
else
aaa=""
end if
bbb=mid(content,pos+3,(mmmm-(pos+3)+1))
content=aaa+"{$错误的标签(标签库有重名标签存在)$"+bbb
have_label=1
end if
if err2=0 then
'end if
'end if
if err2=0 then
if pos<>1 then
aaa=mid(content,1,pos-1)
else
aaa=""
end if
if mid(content,i+1,1)="}" and i+2<=mmmm then
bbb=mid(content,i+2,(mmmm-(i+2)+1))
else
bbb=""
if mid(content,i+1,1)<>"}" then err2=1
end if
if err2=0 then
if ok_rp=1 then
ndhtmllinkksrt="<!--nd_complie_linkx_start:["+bb+"("+ssbbbbssbs+")]xx-->"
ndhtmllinkkennd="<!--nd_complie_linkx_end:["+bb+"("+ssbbbbssbs+")]xx-->"
if htmledxax=2 then
ndhtmllinkksrt=""
ndhtmllinkkennd=""
end if
errmmms=""
'---------------v3 5--------------
if err_chr_quot=1 then
rs441122.addnew
rs441122("template_full_path_filename")=filepath1
rs441122("complie_status")="标签参数里存在& quot;字符，可能是因为在dreamweaver的设计模式下输入了""号，而""号被自动转为& quot;字符，请在dreamweaver的代码模式下输入""号才可以"
rs441122("error_label_name")=trim(lname)
nnnnear1=20
if instr(1,content_yuan,lname,1)=0 then
errssdtr="该标签嵌套在另一标签的标签正文代码里,无法确定其父标签的位置,该标签名字为"&lname
else
if (instr(1,content_yuan,lname,1)+len(lname)+nnnnear1)<mmmm then
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)+nnnnear1-1
else
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)-1
end if
if (instr(1,content_yuan,lname,1)-nnnnear1)>1 then
snnnnnnnd1=instr(1,content_yuan,lname,1)-nnnnear1
else
snnnnnnnd1=instr(1,content_yuan,lname,1)
end if
errssdtr=mid(content_yuan,snnnnnnnd1,ennnnnnnd1)
end if
rs441122("error_str_near")="..... <font color=red>"&errssdtr&"</font> ......"
rs441122.update
if pos<>1 then
aaa=mid(content,1,pos-1)
else
aaa=""
end if
bbb=mid(content,pos+3,(mmmm-(pos+3)+1))
'content=aaa&"{$错误的标签(可能标签参数里的引号被dreamweawer等转为了& quot;号,请在dreamweaver的代码模式下输入""号才可以)$"&bbb
errmmms=" 错误:可能标签参数里的引号被dreamweawer等转为了& quot;号,请在dreamweaver的代码模式下输入""号才可以. "
have_label=1
else
end if
'--------------------------v3 5-----------
'---------------v4--------------
if err2fmt=1 then
rs441122.addnew
rs441122("template_full_path_filename")=filepath1
rs441122("complie_status")=err2fmt_msg
rs441122("error_label_name")=trim(lname)
nnnnear1=20
if instr(1,content_yuan,lname,1)=0 then
errssdtr="该标签嵌套在另一标签的标签正文代码里,无法确定其父标签的位置,该标签名字为"&lname
else
if (instr(1,content_yuan,lname,1)+len(lname)+nnnnear1)<mmmm then
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)+nnnnear1-1
else
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)-1
end if
if (instr(1,content_yuan,lname,1)-nnnnear1)>1 then
snnnnnnnd1=instr(1,content_yuan,lname,1)-nnnnear1
else
snnnnnnnd1=instr(1,content_yuan,lname,1)
end if
errssdtr=mid(content_yuan,snnnnnnnd1,ennnnnnnd1)
end if
rs441122("error_str_near")="..... <font color=red>"&errssdtr&"</font> ......"
rs441122.update
if pos<>1 then
aaa=mid(content,1,pos-1)
else
aaa=""
end if
bbb=mid(content,pos+3,(mmmm-(pos+3)+1))
'content=aaa&"{$错误的标签("&err2fmt_msg&")$"&bbb
have_label=1
else
end if
'--------------------------v4-----------
if err2fmt=0 and err_chr_quot=0 then
'content=aaa+chr(60)+chr(37)+"'complie-link:label-strat["+bb+"("+ssbbbbssbs+")] "+chr(37)+chr(62)+code_ok+chr(60)+chr(37)+"'complie-link:label-end["+bb+"("+ssbbbbssbs+")] "+chr(37)+chr(62)+bbb
'不能用{"+bb+",要用["+bb+"，防止解析循环
content=aaa&chr(60)&chr(37)&"'complie-link:label-strat["&bb&"("&ssbbbbssbs&")] "&chr(37)&chr(62)&ndhtmllinkksrt&code_ok&ndhtmllinkkennd&chr(60)&chr(37)&"'complie-link:label-end["&bb&"("&ssbbbbssbs&")] "&chr(37)&chr(62)&bbb
have_label=1
else
have_label=1
content=aaa&"{$错误的标签("&err2fmt_msg&errmmms&")$"&bbb
err2fmt=0
err_chr_quot=0
end if
else
end if
end if
end if
end if
end if
if (err2=1 or (have_lprams=1 and have_lpram_shiji=0)) and ok_rp=1 then
rs441122.addnew
rs441122("template_full_path_filename")=filepath1
rs441122("complie_status")="参数个数错误或有多余的空格"
rs441122("error_label_name")=trim(lname)
nnnnear1=20
if instr(1,content_yuan,lname,1)=0 then
errssdtr="该标签嵌套在另一标签的标签正文代码里,无法确定其父标签的位置,该标签名字为"&lname
else
if (instr(1,content_yuan,lname,1)+len(lname)+nnnnear1)<mmmm then
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)+nnnnear1-1
else
ennnnnnnd1=instr(1,content_yuan,lname,1)+len(lname)-1
end if
if (instr(1,content_yuan,lname,1)-nnnnear1)>1 then
snnnnnnnd1=instr(1,content_yuan,lname,1)-nnnnear1
else
snnnnnnnd1=instr(1,content_yuan,lname,1)
end if
errssdtr=mid(content_yuan,snnnnnnnd1,ennnnnnnd1)
end if
rs441122("error_str_near")=".....<font color=red>"&errssdtr&"</font>......"
rs441122.update
if pos<>1 then
aaa=mid(content,1,pos-1)
else
aaa=""
end if
bbb=mid(content,pos+3,(mmmm-(pos+3)+1))
if ok_rp=1 then
content=aaa+"{$错误的标签(参数个数错误或有多余的空格)$"+bbb
have_label=1
end if
end if
count=count+1
'防止自循环如{$$show_news()}的标签代码正文里又含{$$show_news()}它自身
if count>9999 then exit do
loop
'判断有效标签结束
end if
loop
content=replace_webfiles_names(content,cpml_is_cms)
content=replace_ads(content)
rs44.close
set rs44=nothing
rs441122.close
set rs441122=nothing
if glbal_page_splt_str<>"" then
content=content&glbal_page_splt_str
end if
replace_label_main=content
end function
'**********************************************************
'*智能脏话过滤系统v1.0-----by 柏拉图的程序 * 柏 *
'*转载请保留版权信息,多谢 * 拉 *
'*调用方法:sayy=ND_say_what(sayy),sayy为内容输入 * 图 *
'*程序作者:阮丁远,(网名:柏拉图的程序) 版权所有 * 的 *
'*http://www.aspcpu.com * 程 *
'*qq:657697290 * 序 *
'*最后修改:20080609 * 著 *
'*(struct,spring,,....net,www.csdn.net|强人工智能系统 2049年)还未开发基于分词数据库的形容词，名词等归类的，和带自动优先级式分词，
'*(struct,spring,,....net,www.csdn.net|强人工智能系统 2049年)和xml多层式的字与字最大间隔设置(精确到单个字与单个字的间隔，
'*(struct,spring,,....net,www.csdn.net|强人工智能系统 2049年)因为连续的单个字与单个字间可能也有随机性空格) 及语义嵌套，递归式冗余纠错，和
'*(struct,spring,,....net,www.csdn.net|强人工智能系统 2049年)程序语义理解，人工神经元语义理解的更高版本
'**********************************************************
function ND_say_what(sayyyyx)
'本代码使用说明:如 ivv=0,icc=0,zang_data(ivv,0,0)="操|日|靠|ri|cao|草|kao",icc=icc+1,zang_data(ivv,icc,0)="他",zang_data(ivv,icc,1)=2,表示如果"操|日|靠|ri|cao|草|kao"中的"操"字或"日"字或其他字 与 zang_data(ivv,icc,0)="他"中指定的"他"字相隔zang_data(ivv,icc,1)=2指定的2个字的距离或小于2个字距离,就认为此语句为脏话,并自动过滤掉
'*的使用: zang_data(0,0,0)="去死妈",zang_data(0,1,0)="*"之类 表示只要存在"去死妈"这些字 就过滤掉 ,而不用考虑字符距离等 ,这与zang_data(0,0,0)="去死妈",zang_data(0,1,0)=.....不存在 的情况 的效果等效
' 一个英文的长度为1,一个中文的长度也算为1
' 对于 "杀死"两字, 则认为 "杀"字 与 "死"字 相差0个字符, "杀 死"两字中 也认为 "杀"字 与 "死"字 相差0个字符,因为会自动忽略字与字间的空格
zang_len=999
zang_yufa_xiangguan_list_max=22
dim zang_data(999,22,2)
'初始化一切
for zang_lena=0 to zang_len-1
for zang_yufa_xiangguan_lena=0 to zang_yufa_xiangguan_list_max-1
zang_data(zang_lena,zang_yufa_xiangguan_lena,0)=""
zang_data(zang_lena,zang_yufa_xiangguan_lena,1)=2 '指定如果zang_data(zang_lena,zang_yufa_xiangguan_lena,0)的字符串与其对应的后面的数组元素的字符串相隔几个长度或相隔小于此指定的长度值的字符串时才认定为脏话
next
next
konggexx=" "&"$_kongge_$"&" "&"$_kongge_$"&" "&"$_kongge_$"&"<br>"&"$_kongge_$"&"<p>"&"$_kongge_$"&"</p>"&"$_kongge_$"&","&"$_kongge_$"&"'"&"$_kongge_$"&"＂"&"$_kongge_$"&"="&"$_kongge_$"&"="&"$_kongge_$"&"-"&"$_kongge_$"&"_"&"$_kongge_$"&"+"&"$_kongge_$"&"%"&"$_kongge_$"&"$"&"$_kongge_$"&"#"&"$_kongge_$"&"?"&"$_kongge_$"&"!"&"$_kongge_$"&"~"&"$_kongge_$"&"("&"$_kongge_$"&")"&"$_kongge_$"&"<"&"$_kongge_$"&">"&"$_kongge_$"&"["&"$_kongge_$"&"]"&"$_kongge_$"&"{"&"$_kongge_$"&"}"&"$_kongge_$"&":"&"$_kongge_$"&";"&"$_kongge_$"&"."&"$_kongge_$"&"/"&"$_kongge_$"&"\"&"$_kongge_$"&"^"&"$_kongge_$"&"*"&"$_kongge_$"&"@"&"$_kongge_$"&"&"&"$_kongge_$"&"|" '指定所有空格性的字符,用$_kongge_$隔开,这里空格指定了英文空格和中文空格
heihack=" *** " '把脏话替换成什么
'======================================================
'脏话数据库v1.0-20080609,一切脏话的脏话数据库在下面:
ivv=0
icc=0
zang_data(ivv,0,0)="杀|sha|sa|干|gan" '如果 杀 和 死 字同时存在,且两字间相隔的字符数小于或等于对应的zzang_data(aa,yy,1)指定的值,则认定此为脏话
zang_data(ivv,icc,0)="死|si|shi"
zang_data(ivv,icc,1)=0
icc=icc+1
zang_data(ivv,icc,0)="掉"
zang_data(ivv,icc,1)=0
icc=icc+1
zang_data(ivv,icc,0)="了"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="把|ba"
icc=icc+1
zang_data(ivv,icc,0)="杀|sha|sa|干" '把...... 杀 ,相隔5个或小于5个字符串
zang_data(ivv,icc,1)=5
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="去|qu"
icc=icc+1
zang_data(ivv,icc,0)="杀" '把....拉出 去 杀或 去 杀 了 ... ,相隔4个或小于4个字符串
zang_data(ivv,icc,1)=4
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="操|日|靠|ri|cao|草|kao|干|gan|gang|jie|jian|奸"
icc=icc+1
zang_data(ivv,icc,0)="你" '操你妈,操你吗 ,.....
zang_data(ivv,icc,1)=0
icc=icc+1
zang_data(ivv,icc,0)="ma|妈" '可能为 操nima ,操他ma,操tama,... 故其对应的zang_data(aa,yy,1)指定为2
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="ni"
zang_data(ivv,icc,1)=0
icc=icc+1
zang_data(ivv,icc,0)="她" '可能为 操死她,操她,操si她 故其对应的zang_data(aa,yy,1)指定为2
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="他" '可能为 操死他,操他,操si他 故其对应的zang_data(aa,yy,1)指定为2
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="它" '可能为 操死它,操它,操si它 故其对应的zang_data(aa,yy,1)指定为2
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="ta" '可能为 操死ta,操ta,操sita 故其对应的zang_data(aa,yy,1)指定为2
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="娘|niang"
zang_data(ivv,icc,1)=2
icc=icc+1
zang_data(ivv,icc,0)="b|逼" '草你吗b
zang_data(ivv,icc,1)=2
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="我|wo"
icc=icc+1
zang_data(ivv,icc,0)="操|日|靠|ri|cao|草|kao|干|gan|gang|jie|jian|奸|杀|灭"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="操|日|靠|ri|cao|草|kao|奸"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="去你妈|去你吗|去你ma"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="去死"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="你妈|你吗|你ma|你妈"
icc=icc+1
zang_data(ivv,icc,0)="b|逼"
zang_data(ivv,icc,1)=1 '你妈的b ,你妈b
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="性"
icc=icc+1
zang_data(ivv,icc,0)="爱" '性 爱
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="做|zuo|作"
icc=icc+1
zang_data(ivv,icc,0)="爱|ai"
zang_data(ivv,icc,1)=1
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="做|zuo|作"
icc=icc+1
zang_data(ivv,icc,0)="爱|ai"
zang_data(ivv,icc,1)=1
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="a|毛|三级|日本"
icc=icc+1
zang_data(ivv,icc,0)="片|pian"
zang_data(ivv,icc,1)=2
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="av|性"
icc=icc+1
zang_data(ivv,icc,0)="工作者"
zang_data(ivv,icc,1)=20
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="日本"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="看|see"
icc=icc+1
zang_data(ivv,icc,0)="三级"
zang_data(ivv,icc,1)=3
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="找"
icc=icc+1
zang_data(ivv,icc,0)="小姐"
zang_data(ivv,icc,1)=2
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="晚上"
icc=icc+1
zang_data(ivv,icc,0)="小姐"
zang_data(ivv,icc,1)=12
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="傻|sha|sa|啥|s"
icc=icc+1
zang_data(ivv,icc,0)="b|比|逼"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="s"
icc=icc+1
zang_data(ivv,icc,0)="b"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="变态"
icc=icc+1
zang_data(ivv,icc,0)="杀"
zang_data(ivv,icc,1)=15
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="人"
icc=icc+1
zang_data(ivv,icc,0)="渣"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="垃"
icc=icc+1
zang_data(ivv,icc,0)="圾"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="huan|huang|黄"
icc=icc+1
zang_data(ivv,icc,0)="色|se"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="ma|妈"
icc=icc+1
zang_data(ivv,icc,0)="b|比|逼"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="搞|gao"
icc=icc+1
zang_data(ivv,icc,0)="b|比|逼"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="他|她|它"
icc=icc+1
zang_data(ivv,icc,0)="ma的|妈的|妈地|妈得"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="装"
icc=icc+1
zang_data(ivv,icc,0)="b|比|逼"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="你妈|你吗|你ma|你妈"
icc=icc+1
zang_data(ivv,icc,0)="的"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="神经病"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="有病|有毛病"
icc=icc+1
zang_data(ivv,icc,0)="啊|阿|a|吗"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="找死"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="想死"
icc=icc+1
zang_data(ivv,icc,0)="啊|阿|a|吗"
zang_data(ivv,icc,1)=4
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="想不想"
icc=icc+1
zang_data(ivv,icc,0)="死"
zang_data(ivv,icc,1)=4
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="是不是"
icc=icc+1
zang_data(ivv,icc,0)="死"
zang_data(ivv,icc,1)=4
'-----------------------------
ivv=ivv+1
icc=0
zang_data(ivv,0,0)="拖出去"
icc=icc+1
zang_data(ivv,icc,0)="*"
zang_data(ivv,icc,1)=0
'=====end 脏话数据库=================================================
sayyssx=lcase(sayyyyx)
'第一层循环
for zang_lenav=0 to zang_len-1
aassdaks=trim(zang_data(zang_lenav,0,0))
if aassdaks<>"" then
aassdaksa=split(aassdaks,"|")
'第二层循环,针对 "dsf|2343|34234|df"之类中的各元素扫描
for aassdxsx=0 to ubound(aassdaksa)
sssaac=lcase(trim(aassdaksa(aassdxsx)))
have_di2cen=1
count_lllppt=0
'针对 如果 存在重复的多个类似的脏话,则do while ,直到过滤完
do while have_di2cen=1
count_lllppt=count_lllppt+1
if count_lllppt>9999 then exit do '防止自循环
have_di2cen=0
if instr(1,sayyssx,sssaac,1)<>0 then
posfd=instr(1,sayyssx,sssaac,1)
have_di2cen=1
'第三层循环
for zang_yufa_xiangguan_lenav=1 to zang_yufa_xiangguan_list_max-1
aassdakc=trim(zang_data(zang_lenav,zang_yufa_xiangguan_lenav,0))
aassdakcc=clng(zang_data(zang_lenav,zang_yufa_xiangguan_lenav,1))
need_n2=1
if aassdakc="" and zang_yufa_xiangguan_lenav=1 then
if posfd-1<1 then
sstrt=""
else
sstrt=mid(sayyssx,1,posfd-1)
end if
if posfd+len(sssaac)>len(sayyssx) then
enddt=""
else
enddt=mid(sayyssx,posfd+len(sssaac),len(sayyssx)-(posfd+len(sssaac))+1)
end if
sayyssx=sstrt&thzzzf&enddt
need_n2=0
exit for
end if
if aassdakc<>"" then
aassdakcyy=split(aassdakc,"|")
'第四层循环,针对 "dsf|2343|34234|df"之类中的各元素扫描
for aassdakcx=0 to ubound(aassdakcyy)
sssaacc=lcase(trim(aassdakcyy(aassdakcx)))
thzzzf=heihack
'--1--
if sssaacc="" and aassdakcx=0 and zang_yufa_xiangguan_lenav=1 then
if posfd-1<1 then
sstrt=""
else
sstrt=mid(sayyssx,1,posfd-1)
end if
if posfd+len(sssaac)>len(sayyssx) then
enddt=""
else
enddt=mid(sayyssx,posfd+len(sssaac),len(sayyssx)-(posfd+len(sssaac))+1)
end if
sayyssx=sstrt&thzzzf&enddt
need_n2=0
exit for
end if
'--2--
if sssaacc="*" then
if posfd-1<1 then
sstrt=""
else
sstrt=mid(sayyssx,1,posfd-1)
end if
if posfd+len(sssaac)>len(sayyssx) then
enddt=""
else
enddt=mid(sayyssx,posfd+len(sssaac),len(sayyssx)-(posfd+len(sssaac))+1)
end if
sayyssx=sstrt&thzzzf&enddt
need_n2=0
exit for
end if
'--3--
ttrrrue=0
for fdfdfd_scan=1 to aassdakcc+1
ttrrrue=ttrrrue+1
if posfd+len(sssaac)-1++len(sssaacc)+ttrrrue-1>len(sayyssx) then exit for
'以下用于忽略字与字间的空格性的字符,空格性的字符详见konggexx变量的值
kkkgeee=split(konggexx,"$_kongge_$")
for kkkgeeei=0 to ubound(kkkgeee)
if mid(sayyssx,posfd+len(sssaac)-1+ttrrrue,1)=kkkgeee(kkkgeeei) then
fdfdfd_scan=fdfdfd_scan-1
exit for
end if
next
if mid(sayyssx,posfd+len(sssaac)-1+ttrrrue,len(sssaacc))=sssaacc then
fdzi_pos=posfd+len(sssaac)-1+ttrrrue
if posfd-1<1 then
sstrt=""
else
sstrt=mid(sayyssx,1,posfd-1)
end if
if posfd+len(sssaac)>len(sayyssx) then
enddt=""
else
enddt=mid(sayyssx,posfd+len(sssaac),len(sayyssx)-(posfd+len(sssaac))+1)
end if
sayyssx=sstrt&thzzzf&enddt
new_fdzi_pos=fdzi_pos+(len(thzzzf)-len(sssaac))
if new_fdzi_pos-1<1 then
sstrt=""
else
sstrt=mid(sayyssx,1,new_fdzi_pos-1)
end if
if new_fdzi_pos+len(sssaacc)>len(sayyssx) then
enddt=""
else
enddt=mid(sayyssx,new_fdzi_pos+len(sssaacc),len(sayyssx)-(new_fdzi_pos+len(sssaacc))+1)
end if
sayyssx=sstrt&thzzzf&enddt
need_n2=0
exit for
end if
next
if need_n2=0 then exit for
'执行到这,说明是 第四层循环里 dsf|2343|34234|df之类中 的上一项未匹配,而继续下一项,否则已经跳出本循环,这也就是need_n2变量的作用,当然也有可能再次进入 同一sssaac变量值的 本循环,如果have_di2cen=1的话
next
end if
'执行到这说明第四层循环时 没找到匹配的脏话
if need_n2=0 then exit for
'执行到这,说明是 第三层循环里 数组元素中 的上一项未匹配,而继续下一项,否则已经跳出本循环,这也就是need_n2变量的作用,当然也有可能再次进入 同一sssaac变量值的 本循环,如果have_di2cen=1的话
next
if need_n2=1 then '第三层循环 扫描到末尾,没找到匹配的脏话,不用再do while 了
exit do
end if
end if
loop
'第二层循环,针对 "dsf|2343|34234|df"之类中的各元素扫描
next
end if
'第一层循环
next
ND_say_what=sayyssx
end function
'end 智能脏话过滤系统v1.0-----by 柏拉图的程序
Function CreatePath(fromPath)
Dim objFSO, uploadpath
uploadpath = Year(Now) & "-" & Month(Now) '以年月创建上传文件夹，格式：2007－8
uploadpath = Replace(uploadpath, ".", "_")
On Error Resume Next
Set objFSO =Server.CreateObject(fssoo_nd_var_str_x_customx)
If objFSO.FolderExists(Server.MapPath(fromPath & uploadpath)) = False Then
objFSO.CreateFolder Server.MapPath(fromPath & uploadpath)
End If
If Err.Number = 0 Then
CreatePath = uploadpath & "/"
Else
CreatePath = ""
End If
Set objFSO = Nothing
End Function
Function n_RemoveHTML(strHTML)
Dim objRegExp, Match, Matches
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍历匹配集合，并替换掉匹配的项目
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
n_RemoveHTML=strHTML
Set objRegExp = Nothing
End Function
'****************************************************
'参数说明
'Subject : 邮件标题
'Email : 收件人邮件地址
'Content : 邮件内容
'is_for_qiye_mail 企业子系统不?
'****************************************************
dim is_for_qiye_mail
Public Function SendMailb(Subject, Email, Content)
'
On Error Resume Next
if is_for_qiye_mail=1 then
biao2="[ND_sys]"
set rs22t=server.CreateObject("adodb.recordset")
rs22t.open "select top 1 * from "&biao2&" where type='config_settings_qiye'",conn,1,1
else
set rs22t=server.CreateObject("adodb.recordset")
rs22t.open "select top 1 * from "&biao2&" where type='config_settings'",conn,1,1
end if
ddd1tt=rs22t("data")
dddd12tt=split(ddd1tt,"|")
SiteNamexx=cstr(trim(dddd12tt(2)&" "))
comtype=cstr(dddd12tt(7))
if comtype="0" then
SendMailb ="not_suputted"
exit function
end if
LoginName=cstr(trim(dddd12tt(10)&" "))
LoginPass=cstr(trim(dddd12tt(11)&" "))
MailAddress=cstr(trim(dddd12tt(9)&" "))
Fromer=cstr(trim(dddd12tt(8)&" "))
if comtype="1" then
Set jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
jmail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值j
jmail.Charset = "GB2312" '邮件的文字编码为国标
jmail.ContentType = "text/html" '邮件的格式为HTML格式
jmail.AddRecipient Email '邮件收件人的地址
jmail.From = Fromer '发件人的E-MAIL地址
jmail.FromName = SiteNamexx
If LoginName <> "" And LoginPass <> "" Then
JMail.MailServerUserName = LoginName '您的邮件服务器登录名
JMail.MailServerPassword = LoginPass '登录密码
End If
If Err Then
SendMailb ="not_suputted"
exit function
end if
jmail.Subject = Subject '邮件的标题
JMail.Body = Content
JMail.Priority = 1'邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
jmail.Send(MailAddress) '执行邮件发送（通过邮件服务器地址）
jmail.Close() '关闭对象
Set JMail = Nothing
If Err Then
SendMailb = "False"
Err.Clear
Else
SendMailb = "OK"
End If
Exit function
end if
if comtype="2" then
Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
objCDOMail.From = Fromer '邮件地址
objCDOMail.To = Email
objCDOMail.Subject = Subject
objCDOMail.BodyFormat = 0
objCDOMail.MailFormat = 0
objCDOMail.Body = Content
If Err <> 0 Then
SendMailb="not_suputted"
Else
objCDOMail.Send
If Err <> 0 Then
SendMailb="False"
Else
SendMailb="OK"
End If
End If
Set objCDOMail = Nothing
exit function
end if
if comtype="3" then
Set Mailer=Server.CreateObject("Persits.MailSender")
Mailer.Charset = "gb2312"
Mailer.IsHTML = True
Mailer.username = LoginName '服务器上有效的用户名
Mailer.password = LoginPass '服务器上有效的密码
Mailer.Priority = 1
'Mailer.Host =
Mailer.Host =MailAddress
Mailer.Port = 25 ' 该项可选.端口25是默认值
Mailer.From = Fromer '邮件地址
Mailer.FromName = SiteNamexx ' 该项可选
Mailer.AddAddress Email,Email
Mailer.Subject = Subject
Mailer.Body = Content
If Err <> 0 Then
SendMailb="not_suputted"
Else
Mailer.Send
If Err <> 0 Then
SendMailb="False"
Else
SendMailb="OK"
End If
End If
Set Mailer = Nothing
exit function
end if
if comtype="CDO.Message" then
If Not IsObject(cdoConfig) Then
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set cdoConfig = Server.CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(sch & "smtpserver") = MailAddress '--SMTP 服务器
'.Item(sch & "smtpserverport") = 25
.Item(sch & "sendusing") = 2
.Item(sch & "smtpaccountname") = SiteNamexx
.Item(sch & "sendemailaddress") = Fromer
.Item(sch & "smtpuserreplyemailaddress") = 25
'.Item(sch & "smtpauthenticate") = cdoBasic
.Item(sch & "sendusername") = LoginName
.Item(sch & "sendpassword") = LoginPass
.update
End With
If Err<>0 Then
SendMailb="False"
exit function
End If
End If
Set Obj = Server.CreateObject("CDO.Message")
With Obj
Set .Configuration = cdoConfig
.To = Email
.Subject = Subject
.TextBody = Content
.Send
End With
Set Obj = Nothing
Set cdoConfig = Nothing
If Err<>0 Then
SendMailb="False"
Else
SendMailb="OK"
End If
exit function
end if
end function
Function DelColumn(TableName,ColumnName,Conn2222a)
err.clear
On Error Resume Next
Conn2222a.Execute("Alter Table "&TableName&" Drop "&ColumnName&"")
if err.number=0 then
DelColumn=1
else
errrstrra=err.Description
err.clear
DelColumn=0
end if
End Function
Function DelTable(TableName,Conn2222a)
err.clear
On Error Resume Next
Conn2222a.Execute("Drop Table "&TableName&"")
if err.number=0 then
DelTable=1
else
errrstrra=err.Description
err.clear
DelTable=0
end if
End Function
Function AddIndex(ByVal TableName, ByVal IndexName, ByVal ValueText,Conn2222a)
'添加索引
'Call AddIndex(ChannelTable, "[TID]", "[TID]")
err.clear
On Error Resume Next
Conn2222a.Execute("CREATE INDEX " & IndexName & " ON " & TableName & "(" & ValueText & ")")
if err.number=0 then
AddIndex=1
else
errrstrra=err.Description
err.clear
AddIndex=0
end if
End Function
Function copy_database_data_to_database(from_conn,to_conn,from_biao,to_biao)
err.clear
On Error Resume Next
if err.number=0 then
copy_database_data_to_database=1
else
errrstrra=err.Description
err.clear
copy_database_data_to_database=0
end if
End Function
'过程名：SaveBeyondFile
'作 用：保存远程的文件到本地
'参 数：LocalFileName ------ 本地文件名
'参 数：RemoteFileUrl ------ 远程文件URL
Function SaveBeyondFile_update_files_from_www_aspcpu_com(LocalFileName,RemoteFileUrl)
on error resume next
SaveBeyondFile_update_files_from_www_aspcpu_com=1
is_trusted_url=1
u_f_filef=lcase(mid(RemoteFileUrl,inStrRev(RemoteFileUrl,"/")+1,len(RemoteFileUrl)-inStrRev(RemoteFileUrl,"/")))
if lcase(mid(u_f_filef,inStrRev(u_f_filef,".")+1,len(u_f_filef)-inStrRev(u_f_filef,".")))<>"new"&"dsof"&"tupd"&"ate" then
'为了防止asp文件等无法下载而不能为之制作更新，可以把asp文件扩展名改为.newdsoftupdate放到网上 然后来下载 即可,可能还要配置虚拟主机或服务器的iis的MIME类型中加.newdsoftupdate的类型为application/octet-stream
errrstrra="<font color=#ff0000>如"&"果"&"是"&"用"&" http://网"&"址 指"&"定"&"远"&"程"&"要"&"下"&"载"&"更"&"新"&"的"&"文"&"件,则"&"url地"&"址最"&"后的"&"文"&"件"&"的"&"扩"&"展"&"名"&"一"&"定"&"要"&"是 "&".ne"&"wdso"&"ft"&"up"&"date </font><br>"
SaveBeyondFile_update_files_from_www_aspcpu_com=0
Exit Function
end if
if instr(1,lcase(left(RemoteFileUrl,26)),"http://www.newdsoft.cn/",1)=0 and (instr(1,lcase(left(RemoteFileUrl,28)),"http://update.aspcpu.com/",1)=0 and (instr(1,lcase(left(RemoteFileUrl,24)),"http://www.aspcpu.com/",1)=0)) then
is_trusted_url=0
end if
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
If .Readystate<>4 then
SaveBeyondFile_update_files_from_www_aspcpu_com=0
errrstrra="<font color=#ff0000>下载更新文件失败,http返回码: "&.Status&"</font><br>"
Exit Function
End If
If .Status > 300 then
SaveBeyondFile_update_files_from_www_aspcpu_com=0
errrstrra="<font color=#ff0000>下载更新文件失败,可能原因:远程文件不存在或者其他原因,http返回码: "&.Status&"</font><br>"
Exit Function
End If
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile server.MapPath(LocalFileName),2
.Cancel()
.Close()
End With
Set Ads=nothing
SaveBeyondFile_update_files_from_www_aspcpu_com=1
end Function
'作 用：取得带端口的URL
Public Function get_url_and_port()
If Request.ServerVariables("SERVER_PORT") = "80" Then
GetSiteUrl = "http://" & Request.ServerVariables("server_name")
Else
GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
End If
get_url_and_port=GetSiteUrl
end Function
'=============================================================
'函数作用：判断发言是否来自外部,禁止机器提交
'=============================================================
Public Function CheckPostx()
On Error Resume Next
Dim server_v1, server_v2
CheckPostx = False
server_v1 = CStr(Request.ServerVariables("HTTP_REFERER"))
server_v2 = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1, 8, Len(server_v2)) = server_v2 Then
CheckPostx = True
End If
End Function
function rep_xml_br(str)
str=replace(str,vbcrlf,"")
str=replace(str,chr(10),"")
str= Replace(str, CHR(13), "")
str= Replace(str, CHR(9), "")
rep_xml_br=str
End Function
function chk_web_creater_script_ver(str)
if lcase(trim(rep_xml_br(str)))="newdsoft_web_creater_script ver 8.5.1" then
chk_web_creater_script_ver=1
else
chk_web_creater_script_ver=0
end if
end function
function chk_web_creater_can_install_ver(str)
if lcase(trim(rep_xml_br(str)))=lcase(trim(ver)) then
chk_web_creater_can_install_ver=1
else
chk_web_creater_can_install_ver=0
end if
end function
function ReadXMLDocumenthttp(patht,strNode)
'为了发现无效网址请加下面这行
On Error Resume Next
err.clear
http_url_err=0
if use_http_post=0 then
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "get",patht,false
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.send()
else
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "POST", patht, False
XmlHttp.setRequestHeader "Content-Length", Len(PostData_G)
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XmlHttp.setRequestHeader "Referer", RefererUrl_G
XmlHttp.Send PostData_G
end if
if err.number<>0 then
http_url_err=1
exit function
end if
Set oXmlDom = server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
oXmlDom.async = True
If oXMLDom.Load(xmlhttp.responseXML) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocumenthttp = oXMLDom.xml
Else
ReadXMLDocumenthttp = trim(rep_xml_br(oXMLDom.documentElement.selectSingleNode(strNode).text))
End If
Else
ReadXMLDocumenthttp = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
Set XmlHttp = Nothing
End Function
function ReadXMLDocumentxhttp(patht,strNode)
if use_http_post=0 then
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "get",patht,false
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.send()
else
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "POST", patht, False
XmlHttp.setRequestHeader "Content-Length", Len(PostData_G)
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XmlHttp.setRequestHeader "Referer", RefererUrl_G
XmlHttp.Send PostData_G
'use_http_post=0
end if
Set oXmlDom = server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
oXmlDom.async = True
If oXMLDom.Load(xmlhttp.responseXML) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocumentxhttp = oXMLDom.xml
Else
set ReadXMLDocumentxhttp = oXMLDom.documentElement.selectSingleNode(strNode)
End If
Else
ReadXMLDocumentxhttp = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
Set XmlHttp = Nothing
End Function
function ReadXMLDocumenthttp_nodes(patht,strNode)
On Error Resume Next
err.clear
http_url_err=0
if use_http_post=0 then
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "get",patht,false
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.send()
else
Set XmlHttp = server.CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "POST", patht, False
XmlHttp.setRequestHeader "Content-Length", Len(PostData_G)
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XmlHttp.setRequestHeader "Referer", RefererUrl_G
XmlHttp.Send PostData_G
end if
if err.number<>0 then
http_url_err=1
exit function
end if
Set oXmlDom = server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
oXmlDom.async = True
If oXMLDom.Load(xmlhttp.responseXML) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocumenthttp_nodes = oXMLDom.xml
Else
set ReadXMLDocumenthttp_nodes = oXMLDom.documentElement.selectNodes(strNode)
End If
Else
ReadXMLDocumenthttp_nodes = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
Set XmlHttp = Nothing
End Function
'xmlroot跟节点名称 row记录行节点名称
Public Function RecordsetToxml(Recordset,row,xmlroot)
Dim i,node,rs,j,DataArray
If xmlroot="" Then xmlroot="xml"
If row="" Then row="row"
Set RecordsetToxml=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
RecordsetToxml.appendChild(RecordsetToxml.createElement(xmlroot))
If Not Recordset.EOF Then
DataArray=Recordset.GetRows(-1)
For i=0 To UBound(DataArray,2)
Set Node=RecordsetToxml.createNode(1,row,"")
j=0
For Each rs in Recordset.Fields
node.attributes.setNamedItem(RecordsetToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
j=j+1
Next
RecordsetToxml.documentElement.appendChild(Node)
Next
End If
DataArray=Null
End Function
Public Function ArrayToxml(DataArray,Recordset,row,xmlroot)
Dim i,node,rs,j
If xmlroot="" Then xmlroot="xml"
Set ArrayToxml=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
ArrayToxml.appendChild(ArrayToxml.createElement(xmlroot))
If row="" Then row="row"
For i=0 To UBound(DataArray,2)
Set Node=ArrayToxml.createNode(1,row,"")
j=0
For Each rs in Recordset.Fields
node.attributes.setNamedItem(ArrayToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
j=j+1
Next
ArrayToxml.documentElement.appendChild(Node)
Next
End Function
Public Function SaveXMLDocument(ByVal strXMLFile,ByVal strXMLDom)
Dim oXMLDom
SaveXMLDocument = False
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If oXMLDom.LoadXml(strXMLDom) Then
oXMLDom.save strXMLFile
SaveXMLDocument = True
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
SaveXMLDocument = False
End If
End Function
Public Function ReadXMLDocument(strXMLFile,strNode)
if use_http_url=1 then
sssurh=ReadXMLDocumenthttp(strXMLFile,strNode)
ReadXMLDocument=sssurh
exit function
end if
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(oXMLDom.createElement("xml"))
'response.write oXMLDom.Load("<root><b></b></root>")
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocument = oXMLDom.xml
Else
ReadXMLDocument = trim(rep_xml_br(oXMLDom.documentElement.selectSingleNode(strNode).text))
End If
Else
ReadXMLDocument = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
End Function
Public Function ReadXMLDocumentx(strXMLFile,strNode)
if use_http_url=1 then
sssurh=ReadXMLDocumentxhttp(strXMLFile,strNode)
ReadXMLDocumentx=sssurh
exit function
end if
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(oXMLDom.createElement("xml"))
'response.write oXMLDom.Load("<root><b></b></root>")
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocumentx = oXMLDom.xml
Else
set ReadXMLDocumentx = oXMLDom.documentElement.selectSingleNode(strNode)
End If
Else
ReadXMLDocumentx = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then
Err.Clear
end if
End Function
Public Function ReadXMLDocument_nodes(strXMLFile,strNode)
'Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
'Wss_IsUsed = Newasp.ChkNumeric(XmlNode.getAttribute("wss_isused"))
'为了发现无效网址请加下面这行
On Error Resume Next
if use_http_url=1 then
set sssurh=ReadXMLDocumenthttp_nodes(strXMLFile,strNode)
if http_url_err=1 or err.number<>0 then
ReadXMLDocumenthttp_nodes=""
exit function
end if
set ReadXMLDocument_nodes=sssurh
exit function
end if
If strXMLFile = "" Then Exit Function
If InStr(strXMLFile, ":") = 0 Then strXMLFile = Server.MapPath(strXMLFile)
Set oXMLDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
'oXMLDom.appendChild(XMLDom.createElement("xml"))
If oXMLDom.Load(strXMLFile) Then
If strNode = "" Or strNode = "0" Then
ReadXMLDocument_nodes = oXMLDom.xml
Else
set ReadXMLDocument_nodes = oXMLDom.documentElement.selectNodes(strNode)
End If
Else
ReadXMLDocument_nodes = ""
End If
Set oXMLDom = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
' ==========================.ex================================================
' Sub ReponseData()
' If Act <> "getinfo" Then
' XmlDoc.loadxml "<root><appid>dvbbs</appid><status>0</status><body><message/></body></root>"
' End If
' XmlDoc.documentElement.selectSingleNode("appid").text = "newasp"
' If API_Debug And Act <> "reguser" Then
' XmlDoc.documentElement.selectSingleNode("status").text = 0
' Messenge = ""
' Else
' XmlDoc.documentElement.selectSingleNode("status").text = status
' End If
' XmlDoc.documentElement.selectSingleNode("body/message").text = ""
' Set Node = XmlDoc.createCDATASection(Replace(Messenge,"]]>","]]>"))
' XmlDoc.documentElement.selectSingleNode("body/message").appendChild(Node)
' Response.Clear
' Response.ContentType="text/xml"
' Response.CharSet="gb2312"
' Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
' Response.Write XmlDoc.documentElement.XML
'End Sub
' Dom.documentElement.selectSingleNode("setting/checkuser[@usergroupid="&usergroupid&"]") is Nothing Then
' If Not Node is Nothing Then
' Set Node=Dom.documentElement.selectSingleNode("setting/nocheck[username='"&Dvbbs.Checkstr(Request("username"))&"']")
' If Node is Nothing Then
' For Each node in Dom.documentElement.selectNodes("setting")
' Node.selectSingleNode("nocheck").appendChild(Dom.createNode(1,"username","")).text=Request("username")
' Next
' End If
' End If
' If position < Node.length +1 Then
' Dom.documentElement.removeChild(Node(position-1))
' End If
' For each boardid in Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board/@boardid")
' Set Node =XMLDom.documentElement.selectNodes("result[@boardid="& boardid.text &"]")
' ==========================.ex================================================
Public Function XMLEncode(ByVal str)
Dim i
str = Replace(str,"&","&")
For i = 0 to 31
str = Replace(str,Chr(i),"&#"&i&";")
Next
For i = 95 to 96
str = Replace(str,Chr(i),"&#"&i&";")
Next
XMLEncode = str
End Function
Public Function XMLDecode(ByVal str)
Dim i
str = Replace(str,"&","&")
For i = 0 to 31
str = Replace(str,"&#"&i&";",Chr(i))
Next
For i = 95 to 96
str = Replace(str,"&#"&i&";",Chr(i))
Next
XMLDecode = str
End Function
function chk_bef_ver(xml_path,filename)
chk_bef_ver=1
xm_d_ver=ReadXMLDocument(xml_path,"ver")
if chk_web_creater_script_ver(xm_d_ver)=0 then
errrstrra=filename&"的版本 不受本系统里的脚本解释器支持，或则"&filename&"文件已损坏<br>"
chk_bef_ver=0
exit function
end if
set xm_d_zhic=ReadXMLDocument_nodes(xml_path,"can_install_in_what_sys_ver/v")
can_inst=0
v_list_i=""
for aia=0 to xm_d_zhic.length-1
if chk_web_creater_can_install_ver(xm_d_zhic(aia).text)=1 then
can_inst=1
end if
v_list_i=v_list_i&xm_d_zhic(aia).text&" ,"
next
v_list_i=left(v_list_i,len(v_list_i)-1)
if can_inst=0 then
errrstrra="此安装脚本("&filename&")不能在 "&ver&"版本 的新动软网站系统里执行，因为本系统的版本不在此模板支持的版本列表内,此安装脚本支持的系统版本列表如下:"&v_list_i
chk_bef_ver=0
exit function
end if
end function
Function is_RPC_update_file(copy_s_patha,fromaaa)
if instr(1,lcase(fromaaa),"http://",1)=0 and instr(1,lcase(fromaaa),"https://",1)=0 then
is_RPC_update_file=server.mappath(copy_s_patha&fromaaa)
exit function
else
LocalFileNamea="../../SYSTemp/update_files_temp/"&"temp_rpc.newdsoftupdate"
u_f_fnnertstge=lcase(mid(fromaaa,inStrRev(fromaaa,"/")+1,len(fromaaa)-inStrRev(fromaaa,"/")))
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*9999))
u_d_dfgfd=lcase(mid(fromaaa,1,inStrRev(fromaaa,"/")))
u_d_dfgfd=u_d_dfgfd&"nd_pak*****"&rnddd&"_"&u_f_fnnertstge
'以下用于支持无限级目录
call createfile(LocalFileNamea,"1111",true)
nsmgg="<font color=#11ff11>[远程下载]</font><font color=#0000ff>正在从以下网址: "&u_d_dfgfd&" 下载更新文件...</font><br>"
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
if SaveBeyondFile_update_files_from_www_aspcpu_com(LocalFileNamea,fromaaa)=0 then
is_RPC_update_file="|rpc_sys_error|"
nsmgg="<font color=#ff0000>下载更新文件失败...<br>"
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
exit function
else
if is_trusted_url=0 then
nsmgg="<font style='font-size:14px;color:#ff0000'>[系"&"统"&"提"&"示]推"&"荐您"&"不"&"要执"&"行会"&"从其"&"他非 新"&"动"&"软官"&"方"&"网站(ww"&"w.a"&"s"&"p"&"cp"&"u.com)的网"&"站 里"&"下"&"载"&"更"&"新文件 的升"&"级脚本,这"&"样"&"可"&"能不"&"安"&"全,如"&"果"&"有"&"必"&"要,请"&"您"&"检"&"查"&"这"&"些"&"更"&"新"&"文件"&"的安"&"全"&"性..</font><br>"
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
nsmgg="<script language=javascript>alert('系"&"统检"&"测到 升级脚本正"&"在从其"&"他"&"非 新"&"动"&"软"&"官"&"方"&"网站(ww"&"w.a"&"s"&"p"&"cp"&"u.com)的网站 里"&"下载"&"更"&"新"&"文件,这"&"样"&"可能"&"导"&"致"&"有"&"风"&"险"&"的操"&"作,如"&"果"&"有"&"必"&"要,请"&"您"&"检"&"查"&"这"&"些"&"更"&"新"&"文件"&"的安"&"全"&"性.. ')</script>"
if url_beeped_count="" then
url_beeped_count=1
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
else
if url_beeped_count<3 then
url_beeped_count=url_beeped_count+1
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
end if
is_RPC_update_file=server.mappath(LocalFileNamea)
nsmgg="<font color=#0000ff>成功下载更新文件,开始拷贝...<br>"
response.write(nsmgg)
'ist_msg=ist_msg&nsmgg
response.Flush()
exit function
end if
end if
end function
Function install_copy_label(scrt_path,template_path,fff)
'<from_folder>
'<folder><!--请使用相对于本模板目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'admin_files_update_ndsoft
'</folder>
'<is_using_custom_path>
'0
'</is_using_custom_path>
'<custom_path><!--请使用相对于本系统所在根目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'updatetemp/
'</custom_path>
'</from_folder>
'<copylist><!--以下的from里添的路径是相对于上面from_folder里设置的文件夹路径的，开头不用加/号-->
'<!--以下的to里添的路径是相对于本系统所在根目录的，开头不用加/号,必须以Label/custom_Label开始-->
'<!--以下的rewrite_enable指定如果存在同名文件，是否强制覆盖-->
'<!--from节点的值为一个带http://的网址时，该from对应的升级用的新文件将自动下载-->
'<copy><from>1.asp</from><to>Label/custom_Label/test/1.asp</to><rewrite_enable>0</rewrite_enable></copy>
'<copy><from>2.asp</from><to>Label/custom_Label/test/2.asp</to><rewrite_enable>0</rewrite_enable></copy>
'</copylist>
set fileaw1=new Cls_FSO
'if trim(scrt_path)="" or fileaw1.ReportFileStatus(server.mappath(scrt_path))=-1 then
if trim(scrt_path)="" then
errrstrra="标签拷贝脚本不存在..<br>"
install_copy_label=0
exit function
else
if chk_bef_ver(scrt_path,fff)=0 then
install_copy_label=0
exit function
else
if cstr(ReadXMLDocument(scrt_path,"from_folder/is_using_custom_path"))="0" or cstr(ReadXMLDocument(scrt_path,"from_folder/is_using_custom_path"))="" then
copy_s_path=trim(template_path&ReadXMLDocument(scrt_path,"from_folder/folder"))
else
copy_s_path=trim("../../"&ReadXMLDocument(scrt_path,"from_folder/custom_path"))
end if
if right(copy_s_path,1)<>"/" then copy_s_path=copy_s_path&"/"
set aasc=ReadXMLDocument_nodes(scrt_path,"copylist/copy")
copy_l_errmsg=""
for aiaa=0 to aasc.length-1
fromaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("from").text))
toaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("to").text))
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*9999))
u_d_dfgfds="_nd_pak*****"&rnddd&"_"
if left(lcase(toaa),18)<>"label/custom_label" then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&toaa&"中必须是label/custom_label开头的路径</font><br>"
else
'要精确覆盖，不指定$rnd$标签在文件名里，且如果随机命名，执行多次，标签会重复
ttoaaa="../../"&toaa
'以下用于支持无限级目录
call createfile(ttoaaa&"ruandingyuan_newdsoft_temp","1111",true)
call deletefile(ttoaaa&"ruandingyuan_newdsoft_temp")
if fileaw1.ReportFileStatus(server.mappath(ttoaaa))=1 then
if trim(rep_xml_br(aasc(aiaa).selectSingleNode("rewrite_enable").text))<>"1" then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&ttoaaa&" 拷贝脚本里设置了不允许覆盖,拷贝失败..</font><br>"
else
'以下用于支持无限级目录
call createfile(ttoaaa,"1111",true)
call deletefile(ttoaaa)
ok_frm_path=is_RPC_update_file(copy_s_path,fromaa)
if ok_frm_path="|rpc_sys_error|" then
install_copy_label=0
exit function
end if
if fileaw1.CopyAFile(ok_frm_path,server.mappath(ttoaaa))=-1 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"©_s_path&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
else
if err.number<>0 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&ttoaaa&" 拷贝失败..</font><br>"
else
copy_l_errmsg=copy_l_errmsg&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝成功..<br>"
end if
end if
end if
else
ok_frm_path=is_RPC_update_file(copy_s_path,fromaa)
if ok_frm_path="|rpc_sys_error|" then
install_copy_label=0
exit function
end if
if fileaw1.CopyAFile(ok_frm_path,server.mappath(ttoaaa))=-1 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"©_s_path&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
else
if err.number<>0 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" 拷贝失败..</font><br>"
else
copy_l_errmsg=copy_l_errmsg&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝成功..<br>"
end if
end if
end if
end if
next
install_copy_label=1
end if
end if
End Function
Function install_copy_admin_file(scrt_path,template_path,fff)
'<from_folder>
'<folder><!--请使用相对于本模板目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'admin_files_update_ndsoft
'</folder>
'<is_using_custom_path>
'0
'</is_using_custom_path>
'<custom_path><!--请使用相对于本系统所在根目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'updatetemp/
'</custom_path>
'</from_folder>
'<copylist><!--以下的from里添的路径是相对于上面from_folder里设置的文件夹路径的，开头不用加/号-->
'<!--以下的rewrite_enable指定如果存在同名文件，是否强制覆盖-->
'<!--from节点的值为一个带http://的网址时，该from对应的升级用的新文件将自动下载-->
'<copy><from>1.asp</from><to>admin/test/1.asp</to><rewrite_enable>0</rewrite_enable></copy>
'<copy><from>2.asp</from><to>test/2.asp</to><rewrite_enable>0</rewrite_enable></copy>
'</copylist>
set fileaw1=new Cls_FSO
'if trim(scrt_path)="" or fileaw1.ReportFileStatus(server.mappath(scrt_path))=-1 then
if trim(scrt_path)="" then
errrstrra="后台文件升级脚本不存在..<br>"
install_copy_admin_file=0
exit function
else
if chk_bef_ver(scrt_path,fff)=0 then
install_copy_admin_file=0
exit function
else
if cstr(ReadXMLDocument(scrt_path,"from_folder/is_using_custom_path"))="0" or cstr(ReadXMLDocument(scrt_path,"from_folder/is_using_custom_path"))="" then
copy_s_path=trim(template_path&ReadXMLDocument(scrt_path,"from_folder/folder"))
else
copy_s_path=trim("../../"&ReadXMLDocument(scrt_path,"from_folder/custom_path"))
end if
if right(copy_s_path,1)<>"/" then copy_s_path=copy_s_path&"/"
set aasc=ReadXMLDocument_nodes(scrt_path,"copylist/copy")
copy_l_errmsg=""
for aiaa=0 to aasc.length-1
fromaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("from").text))
toaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("to").text))
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*9999))
u_d_dfgfds="_nd_pak*****"&rnddd&"_"
if left(lcase(toaa),1)="/" then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&fromaa&"中必须不能以/号开头 （是相对于此拷贝脚本里的from_folder里设置的文件夹路径的）</font><br>"
else
'要精确覆盖，不指定$rnd$标签在文件名里
ttoaaa="../../"&toaa
'以下用于支持无限级目录
call createfile(ttoaaa&"ruandingyuan_newdsoft_temp","1111",true)
call deletefile(ttoaaa&"ruandingyuan_newdsoft_temp")
if fileaw1.ReportFileStatus(server.mappath(ttoaaa))=1 then
if trim(rep_xml_br(aasc(aiaa).selectSingleNode("rewrite_enable").text))<>"1" then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&ttoaaa&" 拷贝脚本里设置了不允许覆盖,拷贝失败..</font><br>"
else
'以下用于支持无限级目录
call createfile(ttoaaa,"1111",true)
call deletefile(ttoaaa)
ok_frm_path=is_RPC_update_file(copy_s_path,fromaa)
if ok_frm_path="|rpc_sys_error|" then
install_copy_admin_file=0
exit function
end if
if fileaw1.CopyAFile(ok_frm_path,server.mappath(ttoaaa))=-1 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"©_s_path&fromareplace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
errrstrra="<font color=#ff0000>"©_s_path&fromaa&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
install_copy_admin_file=0
exit function
else
if err.number<>0 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&ttoaaa&" 拷贝失败..</font><br>"
errrstrra="<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝失败..</font><br>"
install_copy_admin_file=0
exit function
else
copy_l_errmsg=copy_l_errmsg&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝成功..<br>"
end if
end if
end if
else
ok_frm_path=is_RPC_update_file(copy_s_path,fromaa)
if ok_frm_path="|rpc_sys_error|" then
install_copy_admin_file=0
exit function
end if
if fileaw1.CopyAFile(ok_frm_path,server.mappath(ttoaaa))=-1 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"©_s_path&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
errrstrra="<font color=#ff0000>"©_s_path&fromaa&"中的指定的"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&"文件不存在</font><br>"
install_copy_admin_file=0
exit function
else
if err.number<>0 then
copy_l_errmsg=copy_l_errmsg&"<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> "&ttoaaa&" 拷贝失败..</font><br>"
errrstrra="<font color=#ff0000>"&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝失败..</font><br>"
install_copy_admin_file=0
exit function
else
copy_l_errmsg=copy_l_errmsg&replace(lcase(fromaa),".newdsoftupdate",u_d_dfgfds&".newdsoftupdate")&" --> w"&ttoaaa&"w 拷贝成功..<br>"
end if
end if
end if
end if
next
install_copy_admin_file=1
end if
end if
End Function
Function install_update_datebase_biao(scrt_path,template_path,fff,Conn2222a)
'sql="CREATE TABLE "&ChannelTable&" ([ID] int IDENTITY (1, 1) NOT NULL CONSTRAINT PrimaryKey PRIMARY KEY,"&_
' "NewuyyD varchar(20),"&_
' "TIyu varchar(22),"&_
' "Keuords varchar(255),"&_
' "TueType varchar(30),"&_
' "Tuyue varchar(200),"&_
' "Fyuyule varchar(255),"&_
' "Iyutro text,"&_
' "Shoutyumment tinyint Default 0,"&_
' "TitltutColor varchar(30),"&_
' "Tit456ype varchar(30),"&_
' "ArticleContent text,"&_
' "Author varchar(30),"&_
' "Origin varchar(40),"&_
' "Rank varchar(10),"&_
' "Hits int Default 0,"&_
' "AddDate datetime,"&_
' "SpecialID varchar(255),"&_
' "JSID varchar(200),"&_
' "TemplateID varchar(255),"&_
' "Fname varchar(200),"&_
' "RtyushTF tinyint default 0,"&_
' "ArtiyuInput varchar(50),"&_
' "Picyul varchar(150),"&_
' "Picyuws tinyint default 0,"&_
' "Chyuges tinyint default 0,"&_
' "Recyuend tinyint Default 0,"&_
' "Rolls tinyint Default 0,"&_
' "Strip tinyint Default 0,"&_
' "Pytuopular tinyint Default 0,"&_
' "Vuyuic tinyint Default 0,"&_
' "Sliyuyu tinyint Default 0,"&_
' "Coyuent tinyint Default 0,"&_
' "Isuip tinyint Default 0,"&_
' "DelTF tinyint Default 0,"&_
' "Oruiui tinyint Default 1,"&_
' "Iuiurview tinyint Default 0,"&_
' "ArrGuyipID varchar(100),"&_
' "Reauiuioint int Default 0,"&_
' "Chiuiype tinyint Default 0,"&_
' "PituiuiTime int Default 24,"&_
' "Readiui int Default 10,"&_
' "Dividuircent int Default 0"&_
' ")"
If conn_is_closed=1 Then
call openconn()
conn_is_closed=0
End If
On Error Resume Next
install_update_datebase_biao=1
set fileaw1=new Cls_FSO
'if trim(scrt_path)="" or fileaw1.ReportFileStatus(server.mappath(scrt_path))=-1 then
if trim(scrt_path)="" then
errrstrra="数据库结构升级脚本不存在..<br>"
install_update_datebase_biao=0
exit function
else
if chk_bef_ver(scrt_path,fff)=0 then
install_update_datebase_biao=0
exit function
else
set aasc=ReadXMLDocument_nodes(scrt_path,"sqlcmdlist/sql")
errrstrra=""
copy_l_errmsg=""
for aiaa=0 to aasc.length-1
typea=trim(rep_xml_br(aasc(aiaa).selectSingleNode("type").text))
sscmd=trim(rep_xml_br(aasc(aiaa).selectSingleNode("cmd").text))
'<sqlcmdlist>
'<sql>
'<cmd>
'<!--delete_if_exists_table([test_update],ff|a|)的功能是:如果存在一个含字段ff,a的表就把它删除，如果不存在就不删,注意这个命令的type'设置为newdsoft_sql-->
'<![CDATA[
'delete_if_exists_table([test_update],ff|a|)
']]>
'</cmd>
'<type>newdsoft_sql</type>
'</sql>
'<sql>
'<cmd>
'<![CDATA[
'CREATE TABLE [test_update] ([ff] int IDENTITY (1, 1) NOT NULL CONSTRAINT PrimaryKey PRIMARY KEY,a varchar(200))
']]>
'</cmd>
'<type>sys_sql</type>
'</sql>
'</sqlcmdlist>
if typea="sys_sql" then
Conn2222a.Execute(sscmd)
else
if typea="newdsoft_sql" then
'----------newdsoft_sql_case-------------------------------
'<!--delete_if_exists_table([test_update],ff|a|)的功能是:如果存在一个含字段ff,a的表就把它删除，如果不存在就不删,注意这个命令的type'设置为newdsoft_sql-->
if lcase(left(trim(sscmd),22))="delete_if_exists_table" then
Set regExb = New RegExp
regExb.IgnoreCase = True
regExb.Global = True
regExb.Pattern="delete_if_exists_table\s*\({0,1}([^\)]+)\){0,1}"
strTemp = regExb.Replace(sscmd,"$1")
strTemp =trim(strTemp)
sqlaax=""
serrs=0
if ubound(split(strTemp,","))=0 then
sqlaax_f="select * from "&strTemp&" "
sqlaax="select * from "&strTemp&" "
bbiaoa=strTemp
end if
if ubound(split(strTemp,","))=1 then
sqlaaxa=trim(split(strTemp,",")(0))
sqlaaxb=trim(split(strTemp,",")(1))
if right(sqlaaxb,1)="|" then sqlaaxb=left(sqlaaxb,len(sqlaaxb)-1)
sqlaaxbc=""
for iai=0 to ubound(split(sqlaaxb,"|"))
sqlaaxbc=sqlaaxbc&split(sqlaaxb,"|")(iai)&","
next
sqlaaxbc=left(sqlaaxbc,len(sqlaaxbc)-1)
sqlaax_f="select * from "&sqlaaxa&" "
sqlaax="select "&sqlaaxbc&" from "&sqlaaxa&" "
bbiaoa=sqlaaxa
end if
if ubound(split(strTemp,","))>=2 then
errrstrra=errrstrra&"执行sql出错:<font color=#ff0000>命令delete_if_exists_table的参数个数有错误</font><br>"
err.clear
install_update_datebase_biao=0
serrs=1
end if
if serrs=0 then
err.clear
conn.execute(sqlaax_f)
if err.number<>0 then
err.clear
copy_l_errmsg=copy_l_errmsg&"<font color=#0000ff>表"&bbiaoa&"不存在,已放弃删除操作"&sscmd&"<br>"
else
conn.execute(sqlaax)
if err.number<>0 then
errrstrra=errrstrra&"要删除的表中不存在命令参数里指定的特征字段(特征字段:"&sqlaaxbc&") ,error:<font color=#ff0000>"&err.Description&"</font>,删除失败<br>"
err.clear
install_update_datebase_biao=0
else
err.clear
Conn.Execute("Drop Table "&bbiaoa&"")
if err.number=0 then
'不用置1，因为上一条可能sql可能错
'install_update_datebase_biao=1
else
errrstrra=errrstrra&"执行sql出错:删除表 失败"&err.Description&"<br>"
err.clear
install_update_datebase_biao=0
end if
end if
end if
end if
end if
'----------------------------------------------------------
else
errrstrra=errrstrra&"<font color=#ff0000>数据库结构升级脚本里指定了未知的命令类型:"&typea&"</font><br>"
install_update_datebase_biao=0
end if
end if
if err.number=0 then
copy_l_errmsg=copy_l_errmsg&"<font color=#0000ff>成功执行SQL:"&sscmd&",命令type:"&typea&"..</font><br><br>"
else
errrstrra=errrstrra&"sql执行出错:<font color=#ff0000>"&err.Description&"</font><br>"
err.clear
install_update_datebase_biao=0
end if
next
end if
end if
call closeconn()
conn_is_closed=1
End Function
function roll_back_db(dirs,bkkd)
If conn_is_closed=1 Then
call openconn()
conn_is_closed=0
End If
if bkkd="" then exit function
set fileaw=new Cls_FSO
nsmgg="<br><hr>安装失败，系统即将自动恢复数据库到安装前的样子，系统正在从以下数据库备份里恢复数据库: <font color=#0088ff>"&bkkd&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
If IsObject(conn) Then
conn.Close
Set conn = Nothing
End If
if fileaw.CopyAFile(server.mappath(dirs&bkkd),server.mappath(dirs&main_data_mdb))=-1 then
nsmgg="恢复数据库失败<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
call OpenConn()
exit function
else
if err.number<>0 then
nsmgg="恢复数据库失败<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
call OpenConn()
exit function
else
nsmgg="恢复数据库成功<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
call deletefile(dirs&bkkd)
nsmgg="正在清理数据库备份..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
nsmgg="清理数据库备份成功..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
call OpenConn()
end if
end if
end function
xJET_3X = 4
Function CompactDBx(dbPath, boolIs97)
strDBPath = left(dbPath,instrrev(DBPath,""))
Set fso = CreateObject(fssoo_nd_var_str_x_customx)
If fso.FileExists(dbPath) Then
Set Engine = CreateObject("JRO.JetEngine")
If boolIs97 = "True" Then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb;" _
& "Jet OLEDB:Engine Type=" & xJET_3X
Else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
End If
fso.CopyFile strDBPath & "temp.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
Set fso = nothing
Set Engine = nothing
CompactDBx = "你的数据库 " & dbpath & " 已经压缩完毕" & vbCrLf
Else
CompactDBx = "The database name or path has not been found. Try Again" & vbCrLf
End If
End Function
Function install_import_base_data(scrt_path,template_path,fff)
'<from_db>
'<db><!--请使用相对于本模板目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'data_import_ndsoft/##data_in##.mdb
'</db>
'<is_using_custom_path>
'0
'</is_using_custom_path>
'<custom_path><!--请使用相对于本系统所在根目录的相对路径,开头不用加/号,多级目录请用/号隔开-->
'updatetemp/1/1/1/##data_in##.mdb
'</custom_path>
'</from_db>
'<copylist>
'<!--以下的id_field为表的自动编号字段,如果表没有自动编号,请留空-->
'<copy><from_biao>werw</from_biao><to_biao>aaaaa</to_biao><id_field>id</id_field></copy>
'<copy><from_biao>ewrer</from_biao><to_biao>bbbb</to_biao><id_field>id</id_field></copy>
'</copylist>
If conn_is_closed=1 Then
call openconn()
conn_is_closed=0
End If
On Error Resume Next
install_import_base_data=1
set fileaw1=new Cls_FSO
'if trim(scrt_path)="" or fileaw1.ReportFileStatus(server.mappath(scrt_path))=-1 then
if trim(scrt_path)="" then
errrstrra="数据库基础数据导入 脚本不存在..<br>"
install_import_base_data=0
exit function
else
if chk_bef_ver(scrt_path,fff)=0 then
install_import_base_data=0
exit function
else
if cstr(ReadXMLDocument(scrt_path,"from_db/is_using_custom_path"))="0" or cstr(ReadXMLDocument(scrt_path,"from_db/is_using_custom_path"))="" then
copy_s_path=trim(template_path&ReadXMLDocument(scrt_path,"from_db/db"))
else
copy_s_path=trim("../../"&ReadXMLDocument(scrt_path,"from_db/custom_path"))
end if
if right(copy_s_path,1)<>"/" then copy_s_path=copy_s_path&"/"
ConnStrsdsdfjsddfde = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(copy_s_path)
Set conndddbdbdb1s = Server.CreateObject("ADODB.Connection")
conndddbdbdb1s.open ConnStrsdsdfjsddfde
set aasc=ReadXMLDocument_nodes(scrt_path,"copylist/copy")
copy_l_errmsg=""
for aiaa1=0 to aasc.length-1
frombbass=trim(rep_xml_br(aasc(aiaa1).selectSingleNode("from_biao").text))
tobbass=trim(rep_xml_br(aasc(aiaa1).selectSingleNode("to_biao").text))
iddbbass=trim(rep_xml_br(aasc(aiaa1).selectSingleNode("id_field").text))
Conn.execute("delete from ["&tobbass&"]")
if err.number=0 then
'copy_l_errmsg=copy_l_errmsg&"<font color=#0000ff>成功清空表["&tobbass&"]的数据</font><br><br>"
response.write "<font color=#0000ff>成功清空表["&tobbass&"]的数据</font><br><br>"
response.flush()
else
errrstrra=errrstrra&"清空表["&tobbass&"]中的所有数据时出错:<font color=#ff0000>"&err.Description&"</font><br>"
err.clear
install_import_base_data=0
end if
next
err.clear
If IsObject(conn) Then
conn.Close
Set conn = Nothing
End If
call CompactDBx(Server.MapPath(dir_set&main_data_mdb), "-1")
call OpenConn()
if err.number=0 then
'copy_l_errmsg=copy_l_errmsg&"<font color=#0000ff>成功执行了数据库压缩</font><br><br>"
response.write "<font color=#0000ff>成功执行了数据库压缩</font><br><br>"
response.flush()
else
errrstrra=errrstrra&"<script language=javascript>alert('压缩数据库时出错,请关闭所有占用数据库的软件如ACCESS,再执行安装模板');</script>压缩数据库时出错:<font color=#ff0000>"&err.Description&"</font>,请关闭所有占用数据库的软件如ACCESS,再执行安装模板<br>"
err.clear
install_import_base_data=0
exit function
end if
set rs2we2wsaa=server.CreateObject("adodb.recordset")
set rs2we2ws=server.CreateObject("adodb.recordset")
set rs2we2wsaamm=server.CreateObject("adodb.recordset")
set rs2we2wsts=server.CreateObject("adodb.recordset")
for aiaa2=0 to aasc.length-1
frombbass=trim(rep_xml_br(aasc(aiaa2).selectSingleNode("from_biao").text))
tobbass=trim(rep_xml_br(aasc(aiaa2).selectSingleNode("to_biao").text))
iddbbass=trim(rep_xml_br(aasc(aiaa2).selectSingleNode("id_field").text))
nedcpyt=1
err.clear
if iddbbass="" then
rs2we2wsaamm.open "select * from ["&frombbass&"]",conndddbdbdb1s,1,1
else
rs2we2wsaamm.open "select * from ["&frombbass&"] order by clng("&iddbbass&") desc",conndddbdbdb1s,1,1
end if
if err.number<>0 then
errrstrra=errrstrra&"<font color=#0000ff>源表["&frombbass&"]不存在或安装脚本里自动编号字段设置 有异常</font><br>"
err.clear
install_import_base_data=0
nedcpyt=0
rs2we2wsaamm.close
else
if iddbbass="" then
else
mmaxid=clng(rs2we2wsaamm(iddbbass))
end if
rs2we2wsaamm.close
end if
err.clear
rs2we2wsts.open "select * from ["&tobbass&"]",conn,1,1
if err.number<>0 then
errrstrra=errrstrra&"<font color=#0000ff>目的表["&tobbass&"]不存在或安装脚本里自动编号字段设置 有异常</font><br>"
err.clear
install_import_base_data=0
nedcpyt=0
end if
rs2we2wsts.close
if nedcpyt=1 then
if iddbbass="" then
rs2we2wsaa.open "select * from ["&frombbass&"]",conndddbdbdb1s,1,1
else
rs2we2wsaa.open "select * from ["&frombbass&"] order by clng("&iddbbass&") asc",conndddbdbdb1s,1,1
end if
'下面这句屏蔽忘了rs2we2wsaa.close引发的错误的干扰
err.clear
do while not rs2we2wsaa.eof
tttnid=""
rs2we2ws.open "select * from ["&tobbass&"]",conn,1,3
'下面这句屏蔽忘了rs2we2ws.close引发的错误的干扰
err.clear
if iddbbass="" then
rs2we2ws.addnew
lfdth=rs2we2ws.fields.count
for uipi=0 to lfdth-1
rs2we2ws.fields(uipi).value=rs2we2wsaa.fields(uipi).value
next
nnnid=rs2we2wsaa.fields(0).value
idssssd=rs2we2wsaa.fields(0).name
rs2we2ws.update
errlop=0
else
tttnid=rs2we2wsaa(iddbbass)
kaiss=1
lop_count=0
errlop=0
do while kaiss=1 or needlop=1
needlop=0
kaiss=0
rs2we2ws.addnew
lfdth=rs2we2ws.fields.count
for uipi=0 to lfdth-1
rs2we2ws.fields(uipi).value=rs2we2wsaa.fields(uipi).value
next
nnnid=rs2we2ws(iddbbass)
rs2we2ws.update
if cstr(nnnid)<>cstr(rs2we2wsaa(iddbbass)) and clng(nnnid)<mmaxid then
conn.execute("delete from ["&tobbass&"] where "&iddbbass&"="&nnnid)
needlop=1
lop_count=lop_count+1
if lop_count>mmaxid+10 then
errlop=1
exit do
end if
else
needlop=0
end if
loop
rs2we2ws.close()
end if
if errlop=1 then
errrstrra=errrstrra&"<font color=#0000ff>试图同步 源表["&frombbass&"]和 目的表["&tobbass&"]的自动编号字段["&iddbbass&"]时出错，在源表的 字段["&iddbbass&"]="&tttnid&" 处</font><br>"
err.clear
install_import_base_data=0
end if
if err.number<>0 then
errrstrra=errrstrra&"<font color=#0000ff>试图同步 源表["&frombbass&"]和 目的表["&tobbass&"]的数据时发生兼容性问题，可能两个表的结构不一样，在源表的 字段["&iddbbass&"]="&tttnid&" 处,error:"&err.description&"</font><br>"
err.clear
install_import_base_data=0
end if
if iddbbass="" then
shosstrr=idssssd
else
shosstrr=iddbbass
end if
if errlop=0 and err.number=0 then
'copy_l_errmsg=copy_l_errmsg&"<font color=#0000ff>在字段["&shosstrr&"]="&nnnid&" 处同步 源表["&frombbass&"]和 目的表["&tobbass&"]的数据成功..</font><br>"
response.write "<font color=#0000ff>在字段["&shosstrr&"]="&nnnid&" 处同步 源表["&frombbass&"]和 目的表["&tobbass&"]的数据成功..</font><br>"
response.flush()
end if
rs2we2wsaa.movenext
loop
rs2we2wsaa.close()
end if
next
end if
end if
call closeconn()
conn_is_closed=1
end function
function run_scrt_str_update_datebase_biao(str)
On Error Resume Next
use_http_url=0
use_http_post=0
response.write("<center><br><br><br>")
set fileaw=new Cls_FSO
'以下用于支持无限级目录
call createfile("../../XMLTemp/run_xml_cmd_temp.xml","1111",true)
if SaveXMLDocument("../../XMLTemp/run_xml_cmd_temp.xml",str)=true then
dir_seta="../../"
dir_beeff="data\执行sql脚本前的自动备份\"
'以下用于支持无限级目录
call createfile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt","1111",true)
call deletefile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt")
tdbss=dir_beeff&"执行sql脚本前的自动备份-在"&year(date())&"年-"&month(date())&"月-"&day(date())&"日_"&hour(now())&"时-"&minute(now())&"分-"&second(now())&"秒.mdb"
if fileaw.CopyAFile(server.mappath(dir_seta&main_data_mdb),server.mappath(dir_seta&tdbss))=-1 then
response.write("执行 脚本 前备份数据库失败，自动终止执行，执行失败!<br>")
response.write("</center>")
exit function
else
if err.number<>0 then
response.write("执行 脚本 前备份数据库失败，自动终止执行，执行失败!<br>")
response.write("</center>")
exit function
end if
end if
copy_l_errmsg=""
if install_update_datebase_biao("../../XMLTemp/run_xml_cmd_temp.xml","","run_xml_cmd_temp.xml",conn)=0 then
nsmgg=errrstrra&"<br>"
response.write(nsmgg)
response.write("<br>执行失败<br>")
response.Flush()
call roll_back_db(dir_seta,tdbss)
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
response.write("<br>执行成功<br>")
response.Flush()
end if
else
response.write("脚本格式不符合xml规范，存在语法错误<br>")
response.Flush()
end if
response.write("</center>")
end function
function run_scrt_str_update_admin_files(str)
On Error Resume Next
use_http_url=0
use_http_post=0
response.write("<center><br><br><br>")
set fileaw=new Cls_FSO
'以下用于支持无限级目录
call createfile("../../XMLTemp/run_xml_cmd_temp.xml","1111",true)
if SaveXMLDocument("../../XMLTemp/run_xml_cmd_temp.xml",str)=true then
copy_l_errmsg=""
sresers="../../SYSTemp/"
'以下用于支持无限级目录
call createfile(sresers&"ruandingyuan_newd_soft_temp_cs.txt","1111",true)
call deletefile(sresers&"ruandingyuan_newd_soft_temp_cs.txt")
if install_copy_admin_file("../../XMLTemp/run_xml_cmd_temp.xml",sresers,"run_xml_cmd_temp.xml")=0 then
nsmgg=errrstrra&"<br>"
response.write(nsmgg)
response.write("<br>执行失败<br>")
response.Flush()
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
response.write("<br>执行成功<br>")
response.Flush()
end if
else
response.write("脚本格式不符合xml规范，存在语法错误<br>")
response.Flush()
end if
response.write("</center>")
end function
function run_scrt_str_update_label(str)
On Error Resume Next
use_http_url=0
use_http_post=0
response.write("<center><br><br><br>")
set fileaw=new Cls_FSO
'以下用于支持无限级目录
call createfile("../../XMLTemp/run_xml_cmd_temp.xml","1111",true)
if SaveXMLDocument("../../XMLTemp/run_xml_cmd_temp.xml",str)=true then
copy_l_errmsg=""
sresers="../../SYSTemp/"
'以下用于支持无限级目录
call createfile(sresers&"ruandingyuan_newd_soft_temp_cs.txt","1111",true)
call deletefile(sresers&"ruandingyuan_newd_soft_temp_cs.txt")
if install_copy_label("../../XMLTemp/run_xml_cmd_temp.xml",sresers,"run_xml_cmd_temp.xml")=0 then
nsmgg=errrstrra&"<br>"
response.write(nsmgg)
response.write("<br>执行失败<br>")
response.Flush()
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
response.write("<br>执行成功<br>")
response.Flush()
end if
else
response.write("脚本格式不符合xml规范，存在语法错误<br>")
response.Flush()
end if
response.write("</center>")
end function
Function install_a_moban(patha)
'<ver>
'newdsoft_web_creater_script VER 8.5.1
'</ver>
'<can_install_in_what_sys_ver>
'<v> 8.5.1
'</v>
'<v>8.5.2</v>
'</can_install_in_what_sys_ver>
'<template_name>
'ruandy
'</template_name>
'<template_type_qiye_or_cms>
'qiye
'</template_type_qiye_or_cms>
'<label_update_script>
'x_rundiy_copy_all_needed_lable_ndsoft.xml
'</label_update_script>
'<admin_child_sys_files_update_script>
'x_rundiy_copy_admin_sys_child_sys_files_ndsoft.xml
'</admin_child_sys_files_update_script>
'<database_update_script>
'x_rundiy_create_database_table_sql_ndsoft.xml
'</database_update_script>
'<database_biao_data_import>
'x_rundiy_database_data_import_ndsoft.xml
'</database_biao_data_import>
err.clear
On Error Resume Next
ist_msg=""
install_a_moban=1
scrt_ffa="../../templates/"&patha&"/"
scrt_ff="../../templates/"&patha&"/"&iscrtfile
set fileaw=new Cls_FSO
set filebw=new DosAsp
use_http_url=0
use_http_post=0
if fileaw.ReportFolderStatus(server.mappath("../../templates/"&patha&"/"))=-1 then
install_a_moban=0
errrstrra="此模板目录不存在"
exit function
end if
if fileaw.ReportFileStatus(server.mappath(scrt_ff))=-1 then
install_a_moban=1
nsmgg="此模板目录下不存在"&iscrtfile&"安装脚本文件，无需安装"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
'errrstrra=""
exit function
else
'fdatt=loadfile(scrt_ff)
if chk_bef_ver(scrt_ff,iscrtfile)=0 then
install_a_moban=0
exit function
end if
end if
nsmgg="安装前请先备份好系统，以免安装失败后系统发生错误..<br>"
nsmgg=nsmgg&"读取安装脚本成功..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'===================执行后台文件及系统文件升级脚本
xm_d_cad=ReadXMLDocument(scrt_ff,"admin_child_sys_files_update_script")
if trim(xm_d_cad)="" or fileaw.ReportFileStatus(server.mappath(scrt_ffa&xm_d_cad))=-1 then
nsmgg=xm_d_cad&"<font color=#ff0000>后台文件及系统文件升级脚本不存在或未作设置，后台文件及系统文件升级被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_cad&"后台文件及系统文件升级脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行后台文件及系统文件升级脚本可能会覆盖系统的原来的后台文件及系统文件，可能导致危险操作..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_copy_admin_file(scrt_ffa&xm_d_cad,scrt_ffa,xm_d_cad)=0 then
nsmgg=xm_d_cad&"<font color=#ff0000>后台文件及系统文件升级脚本执行失败，或后台文件升级脚本的版本不被支持或本系统的版本不被此脚本支持，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
install_a_moban=0
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
'============end=======执行后台文件升级脚本
'===================执行标签拷贝脚本
xm_d_clb=ReadXMLDocument(scrt_ff,"label_update_script")
if trim(xm_d_clb)="" or fileaw.ReportFileStatus(server.mappath(scrt_ffa&xm_d_clb))=-1 then
nsmgg=xm_d_clb&"<font color=#ff0000>标签拷贝脚本不存在或未作设置，标签拷贝被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_clb&"标签拷贝脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行标签拷贝脚本可能会覆盖系统自带的标签文件，可能导致危险操作..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_copy_label(scrt_ffa&xm_d_clb,scrt_ffa,xm_d_clb)=0 then
nsmgg=xm_d_clb&"<font color=#ff0000>标签拷贝脚本执行失败，或标签拷贝脚本的版本不被支持或本系统的版本不被此脚本支持，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
install_a_moban=0
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
tdbss=""
'===================执行数据库建表等升级操作的脚本
xm_d_db=ReadXMLDocument(scrt_ff,"database_update_script")
if trim(xm_d_db)="" or fileaw.ReportFileStatus(server.mappath(scrt_ffa&xm_d_db))=-1 then
nsmgg=xm_d_db&"<font color=#ff0000>数据库结构升级脚本 不存在或未作设置，数据库结构升级被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
xm_d_db_tmplt=ReadXMLDocument(scrt_ff,"template_name")
if xm_d_db_tmplt="" then xm_d_db_tmplt="未知模板"
xm_d_db_tmplt=replace(xm_d_db_tmplt,"/","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"\","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,":","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"'","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,">","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"<","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"?","")
dir_seta="../../"
dir_beeff="data\安装新模板前自动备份的数据库\"
'以下用于支持无限级目录
call createfile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt","1111",true)
call deletefile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt")
tdbss=dir_beeff&"安装_"&xm_d_db_tmplt&"_这个模板前的自动备份-"&year(date())&"年-"&month(date())&"月-"&day(date())&"日_"&hour(now())&"时-"&minute(now())&"分-"&second(now())&"秒.mdb"
if fileaw.CopyAFile(server.mappath(dir_seta&main_data_mdb),server.mappath(dir_seta&tdbss))=-1 then
errrstrra="执行 数据库结构升级脚本 前备份数据库失败，自动终止安装，安装失败!"
install_a_moban=0
exit function
else
if err.number<>0 then
errrstrra="执行 数据库结构升级脚本 前备份数据库失败，自动终止安装，安装失败!"
install_a_moban=0
exit function
else
nsmgg=xm_d_db&"数据库结构升级脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行数据库结构升级脚本可能会导致数据丢失，系统已经自动为您做好数据库备份,<font color=#0088ff>备份在"&tdbss&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_update_datebase_biao(scrt_ffa&xm_d_db,scrt_ffa,xm_d_db,conn)=0 then
nsmgg=errrstrra&"<br>"
nsmgg=nsmgg&xm_d_db&"<font color=#ff0000>数据库结构升级脚本执行失败(或者脚本版本不兼容)，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
install_a_moban=0
call roll_back_db(dir_seta,tdbss)
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
end if
end if
'============end=======执行数据库建表等升级操作的脚本
'===================执行数据库基础数据导入的脚本
xm_d_db=ReadXMLDocument(scrt_ff,"database_biao_data_import")
if trim(xm_d_db)="" or fileaw.ReportFileStatus(server.mappath(scrt_ffa&xm_d_db))=-1 then
nsmgg=xm_d_db&"<font color=#ff0000>数据库基础数据导入 脚本 不存在或未作设置，数据库基础数据导入 被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_db&"数据库基础数据导入 脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行数据库基础数据导入 脚本可能会导致数据丢失，系统已经自动为您做好数据库备份,<font color=#0088ff>备份在"&tdbss&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_import_base_data(scrt_ffa&xm_d_db,scrt_ffa,xm_d_db)=0 then
nsmgg=errrstrra&"<br>"
nsmgg=nsmgg&xm_d_db&"<font color=#ff0000>数据库基础数据导入 脚本执行失败(或者脚本版本不兼容)，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
install_a_moban=0
call roll_back_db(dir_seta,tdbss)
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
'==============end=====执行数据库基础数据导入的脚本
if err.number=0 then
else
errrstrra=err.Description
err.clear
install_a_moban=0
end if
End Function
newd_main_ww="h"&"t"&"tp"&":/"&"/w"&"w"&"w.a"&"sp"&"cpu.c"&"om"
dim newd_main_ww_b(99)
newd_main_ww_b_len=0
newd_main_ww_b(0)="h"&"t"&"t"&"p:/"&"/"&"ww"&"w.ne"&"w"&"ds"&"of"&"t.c"&"n"
newd_main_ww_b_len=newd_main_ww_b_len+1
newd_main_ww_b(1)="h"&"t"&"tp"&":"&"//1"&"2"&"7.0."&"0."&"1"&"/aspcpu"
%>
<%
dim newd_soft_update_center
Function online_update_all_and_install(patha)
'<ver>
'newdsoft_web_creater_script VER 8.5.1
'</ver>
'<can_install_in_what_sys_ver>
'<v> 8.5.1
'</v>
'<v>8.5.2</v>
'</can_install_in_what_sys_ver>
'<template_name>
'ruandy
'</template_name>
'<template_type_qiye_or_cms>
'qiye
'</template_type_qiye_or_cms>
'<label_update_script>
'x_rundiy_copy_all_needed_lable_ndsoft.xml
'</label_update_script>
'<admin_child_sys_files_update_script>
'x_rundiy_copy_admin_sys_child_sys_files_ndsoft.xml
'</admin_child_sys_files_update_script>
'<database_update_script>
'x_rundiy_create_database_table_sql_ndsoft.xml
'</database_update_script>
'<database_biao_data_import>
'x_rundiy_database_data_import_ndsoft.xml
'</database_biao_data_import>
err.clear
On Error Resume Next
ist_msg=""
online_update_all_and_install=1
'必须为空
scrt_ffa=""
scrt_ff=patha
set fileaw=new Cls_FSO
set filebw=new DosAsp
use_http_url=1
'fdatt=loadfile(scrt_ff)
if chk_bef_ver(patha,"在线升级 xml脚本")=0 then
online_update_all_and_install=0
exit function
end if
nsmgg="正在连接到官方网站,执行系统在线升级操作..<br>"
nsmgg=nsmgg&"升级前请先备份好系统，以免升级失败后系统发生错误..<br>"
nsmgg=nsmgg&"读取升级脚本成功..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'后台文件及系统文件升级脚本必须先执行,因为可能用它来拷贝其他升级脚本到本地
'===================执行后台文件及系统文件升级脚本
xm_d_cad=ReadXMLDocument(scrt_ff,"admin_child_sys_files_update_script")
if trim(xm_d_cad)="" then
nsmgg=xm_d_cad&"<font color=#ff0000>后台文件及系统文件升级脚本不存在或未作设置，后台文件及系统文件升级被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_cad&"后台文件及系统文件升级脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行后台文件及系统文件升级脚本可能会覆盖系统的原来的后台文件及系统文件，可能导致危险操作..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_copy_admin_file(scrt_ffa&xm_d_cad,scrt_ffa,xm_d_cad)=0 then
nsmgg=xm_d_cad&"<font color=#ff0000>后台文件及系统文件升级脚本执行失败，或后台文件升级脚本的版本不被支持或本系统的版本不被此脚本支持，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
online_update_all_and_install=0
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
'============end=======执行后台文件升级脚本
'===================执行标签拷贝脚本
xm_d_clb=ReadXMLDocument(scrt_ff,"label_update_script")
if trim(xm_d_clb)="" then
nsmgg=xm_d_clb&"<font color=#ff0000>标签拷贝脚本不存在或未作设置，标签拷贝被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_clb&"标签拷贝脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行标签拷贝脚本可能会覆盖系统自带的标签文件，可能导致危险操作..<br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_copy_label(scrt_ffa&xm_d_clb,scrt_ffa,xm_d_clb)=0 then
nsmgg=xm_d_clb&"<font color=#ff0000>标签拷贝脚本执行失败，或标签拷贝脚本的版本不被支持或本系统的版本不被此脚本支持，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
online_update_all_and_install=0
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
tdbss=""
'===================执行数据库建表等升级操作的脚本
xm_d_db=ReadXMLDocument(scrt_ff,"database_update_script")
if trim(xm_d_db)="" then
nsmgg=xm_d_db&"<font color=#ff0000>数据库结构升级脚本 不存在或未作设置，数据库结构升级被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
if h_db_bked="" or h_db_bked=0 then
h_db_bked=1
xm_d_db_tmplt=ReadXMLDocument(scrt_ff,"template_name")
if xm_d_db_tmplt="" then xm_d_db_tmplt="未知模板"
xm_d_db_tmplt=replace(xm_d_db_tmplt,"/","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"\","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,":","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"'","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,">","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"<","")
xm_d_db_tmplt=replace(xm_d_db_tmplt,"?","")
dir_seta="../../"
dir_beeff="data\在线升级前自动备份的数据库\"
'以下用于支持无限级目录
call createfile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt","1111",true)
call deletefile(dir_seta&dir_beeff&"ruandingyuan_newd_soft_temp_db_c.txt")
tdbss=dir_beeff&"安装_"&xm_d_db_tmplt&"_这个更新前的自动备份-"&year(date())&"年-"&month(date())&"月-"&day(date())&"日_"&hour(now())&"时-"&minute(now())&"分-"&second(now())&"秒.mdb"
if fileaw.CopyAFile(server.mappath(dir_seta&main_data_mdb),server.mappath(dir_seta&tdbss))=-1 then
errrstrra="执行 数据库结构升级脚本 前备份数据库失败，自动终止安装，安装失败!"
online_update_all_and_install=0
h_db_bked=0
exit function
else
if err.number<>0 then
errrstrra="执行 数据库结构升级脚本 前备份数据库失败，自动终止安装，安装失败!"
online_update_all_and_install=0
h_db_bked=0
exit function
else
nsmgg=xm_d_db&"数据库结构升级脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行数据库结构升级脚本可能会导致数据丢失，系统已经自动为您做好数据库备份,<font color=#0088ff>备份在"&tdbss&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_update_datebase_biao(scrt_ffa&xm_d_db,scrt_ffa,xm_d_db,conn)=0 then
nsmgg=errrstrra&"<br>"
nsmgg=nsmgg&xm_d_db&"<font color=#ff0000>数据库结构升级脚本执行失败(或者脚本版本不兼容)，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
online_update_all_and_install=0
call roll_back_db(dir_seta,tdbss)
h_db_aa=dir_seta
h_db_bb=tdbss
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
end if
else
nsmgg=xm_d_db&"数据库结构升级脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行数据库结构升级脚本可能会导致数据丢失，系统已经自动为您做好数据库备份,<font color=#0088ff>备份在"&tdbss&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_update_datebase_biao(scrt_ffa&xm_d_db,scrt_ffa,xm_d_db,conn)=0 then
nsmgg=errrstrra&"<br>"
nsmgg=nsmgg&xm_d_db&"<font color=#ff0000>数据库结构升级脚本执行失败(或者脚本版本不兼容)，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
online_update_all_and_install=0
call roll_back_db(dir_seta,tdbss)
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
end if
'============end=======执行数据库建表等升级操作的脚本
'===================执行数据库基础数据导入的脚本
xm_d_db=ReadXMLDocument(scrt_ff,"database_biao_data_import")
if trim(xm_d_db)="" then
nsmgg=xm_d_db&"<font color=#ff0000>数据库基础数据导入 脚本 不存在或未作设置，数据库基础数据导入 被跳过..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
else
nsmgg=xm_d_db&"数据库基础数据导入 脚本读取成功，正在解释并执行此脚本..<br>"
nsmgg=nsmgg&"执行数据库基础数据导入 脚本可能会导致数据丢失，系统已经自动为您做好数据库备份,<font color=#0088ff>备份在"&tdbss&"</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
if install_import_base_data(scrt_ffa&xm_d_db,scrt_ffa,xm_d_db)=0 then
nsmgg=errrstrra&"<br>"
nsmgg=nsmgg&xm_d_db&"<font color=#ff0000>数据库基础数据导入 脚本执行失败(或者脚本版本不兼容)，安装失败..</font><br>"
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
online_update_all_and_install=0
call roll_back_db(dir_seta,tdbss)
exit function
else
nsmgg=copy_l_errmsg
response.write(nsmgg)
ist_msg=ist_msg&nsmgg
response.Flush()
end if
end if
'==============end=====执行数据库基础数据导入的脚本
if err.number=0 then
else
errrstrra=err.Description
err.clear
online_update_all_and_install=0
end if
End Function
'自动取得编码格式
function GetEncodeingx(sUrl)
On Error Resume Next
Set http=Server.CreateObject("Microsoft.XMLHTTP")
http.Open "GET",sUrl,False
http.send
if http.status="200" then
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="encoding=\""gb2312"
if re.test(http.responseText) then
encodeing="gb2312"
else
encodeing="utf-8"
end if
set re=nothing
end if
If Err Then
Err.Clear
GetEncodeingx="utf-8"
else
GetEncodeingx=encodeing
End If
set http=nothing
end function
'==================================================
'函数名：BytesToBstr
'作 用：将获取的源码转换为中文
'参 数：Body ------要转换的变量
'参 数：Cset ------要转换的类型
'==================================================
Function BytesToBstr_x(Body, Cset)
Set Objstream = Server.CreateObject("adodb.stream")
Objstream.Type = 1
Objstream.Mode = 3
Objstream.Open
Objstream.Write Body
Objstream.Position = 0
Objstream.Type = 2
Objstream.Charset = Cset
BytesToBstr_x = Objstream.ReadText
Objstream.Close
Set Objstream = Nothing
End Function
'==================================================
'函数名：UrlEncoding
'作 用：转换编码
'==================================================
Function UrlEncoding_x(DataStr)
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr, Si, 1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00) \ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding_x = StrReturn
End Function
Function PostHttpPage_x(RefererUrl, PostUrl, PostData)
'为了发现无效网址请加下面这行
On Error Resume Next
http_url_err=0
Set xmlHttp = server.CreateObject("Microsoft.XMLHTTP")
xmlHttp.Open "POST", PostUrl, False
xmlHttp.setRequestHeader "Content-Length", Len(PostData)
xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlHttp.setRequestHeader "Referer", RefererUrl
xmlHttp.Send PostData
If Err.Number <> 0 Then
http_url_err=1
Set xmlHttp = Nothing
PostHttpPage_x = "Error"
Exit Function
End If
PostHttpPage_x = BytesToBstr_x(xmlHttp.ResponseBody, "GB2312")
Set xmlHttp = Nothing
End Function
function doall_online_updates(urla)
use_http_url=1
doall_online_updates=1
errrstrrb=""
patha=urla
allllerr=0
http_url_err=0
set aasc=ReadXMLDocument_nodes(patha,"update_list")
if http_url_err=1 then
response.write("<font color=#ff0000>升级服务器出现了异常,请稍后更新..</font>")
response.write("<script language=javascript>alert('升级服务器出现了异常,请稍后更新..');</script>")
exit function
end if
errrstrra=""
copy_l_errmsg=""
response.write("<font color=#0000ff style='font-size:14px'>[更新]发现了"&aasc.length&"个需要安装的更新</font><br>")
response.Flush()
for aiaa=0 to aasc.length-1
set aasc=ReadXMLDocument_nodes(patha,"update_list")
nnnname=trim(rep_xml_br(aasc(aiaa).selectSingleNode("pack_name").text))
uueueueru=trim(rep_xml_br(aasc(aiaa).selectSingleNode("update_xml_url_for_you").text))
response.write("<font color=#0000ff style='font-size:14px'>正在安装第"&(aiaa+1)&"个更新包,此更新包名称为:"&nnnname&" <br>(从"&uueueueru&")</font><br>")
response.Flush()
if online_update_all_and_install(uueueueru)=0 then
response.write("<font color=#ff0000>安装第"&(aiaa+1)&"个更新包时失败,此更新包名称为:"&nnnname&"</font><br>")
response.write("可能的原因如下:"&errrstrra&"<br>")
response.Flush()
allllerr=allllerr+1
doall_online_updates=0
errrstrrb=errrstrrb&"<font color=#ff0000>安装第"&(aiaa+1)&"个更新包时失败,此更新包名称为:"&nnnname&"</font>"&errrstrra&"<br>"
else
response.write("<font color=#0000ff>成功安装第"&(aiaa+1)&"个更新包:"&nnnname&" <br>(从"&uueueueru&")</font><br>")
'response.write("<script language=javascript>alert('在线自动更新成功!');
response.Flush()
end if
response.write("<br><hr><br>")
next
response.write("<hr>")
response.write("<font color=#3300ff style='font-size:14px'>在线安装更新结束,检测到了"&aasc.length&"个更新,其中"&allllerr&"个失败</font><hr>")
if allllerr=0 then
errrstrrb=aasc.length
If Request.ServerVariables("SERVER_PORT") = "80" Then
GetSiteUrl = "http://" & Request.ServerVariables("server_name")
Else
GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
End If
if Request.ServerVariables("QUERY_STRING")<>"" then
refsullr=GetSiteUrl&Request.ServerVariables("URL")&"?"&Request.ServerVariables("QUERY_STRING")
else
refsullr=GetSiteUrl&Request.ServerVariables("URL")
end if
newd_soft_update_center_callback=patha
If conn_is_closed=1 Then
call openconn()
conn_is_closed=0
End If
set Rs44update_ce=server.CreateObject("adodb.recordset")
sql="select top 1 * from [ND_sys] where type='ver_to_get_newest_update' order by id desc"
Rs44update_ce.open sql,conn,1,1
if not Rs44update_ce.eof then
ver_infoa=Rs44update_ce("data")
call closeconn()
conn_is_closed=1
else
get_if_have_newest_update_from_newdsoft="0"
exit function
end if
PostData_G=UrlEncoding_x("verinfo="&ver_infoa&"&do=callback&ok=1&furl="&refsullr)
http_url_err=0
call PostHttpPage_x(refsullr,newd_soft_update_center_callback,PostData_G)
if http_url_err=1 then
response.write("<font color=#3300ff style='font-size:14px'>试图通知服务器结束升级操作时发生错误!</font><hr>")
response.Flush()
else
response.write("<font color=#3300ff style='font-size:14px'>与服务器的连接已注销.. @"&now()&"</font><hr>")
response.Flush()
end if
end if
End Function
function get_ok_server()
'为了发现无效网址请加下面这行
On Error Resume Next
get_ok_server=0
err.clear
If conn_is_closed=1 Then
call openconn()
conn_is_closed=0
End If
set Rs44update_ce=server.CreateObject("adodb.recordset")
sql="select top 1 * from [ND_sys] where type='ver_to_get_newest_update' order by id desc"
Rs44update_ce.open sql,conn,1,1
if not Rs44update_ce.eof then
ver_infoa=Rs44update_ce("data")
call closeconn()
conn_is_closed=1
else
get_if_have_newest_update_from_newdsoft="0"
exit function
end if
f_u_str_ctr_ww="/"&"ne"&"wdsof"&"tUpd"&"ateS"&"erv"&"er/ce"&"nt"&"er/"&"ge"&"t_new"&"est_"&"up"&"da"&"te"&".a"&"sp"
newd_soft_update_center=newd_main_ww&f_u_str_ctr_ww
If Request.ServerVariables("SERVER_PORT") = "80" Then
GetSiteUrl = "http://" & Request.ServerVariables("server_name")
Else
GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
End If
if Request.ServerVariables("QUERY_STRING")<>"" then
refsullr=GetSiteUrl&Request.ServerVariables("URL")&"?"&Request.ServerVariables("QUERY_STRING")
else
refsullr=GetSiteUrl&Request.ServerVariables("URL")
end if
PostData_G=UrlEncoding_x("verinfo="&ver_infoa&"&do=get_list&furl="&refsullr)
LData = PostData_G
myyy_strPath = RefererUrl_G
response.write("正在连接到 "&newd_main_ww&" ..<br>")
response.Flush()
call PostHttpPage_x(myyy_strPath, newd_soft_update_center, LData)
if http_url_err=1 then
response.write("连接 "&newd_main_ww&"时出现异常,正在试图连接其他服务器 ..<br>")
response.Flush()
for ipipi=0 to newd_main_ww_b_len-1
http_url_err=0
err.clear
newd_soft_update_center=newd_main_ww_b(ipipi)&f_u_str_ctr_ww
response.write("正在连接到 "&newd_main_ww_b(ipipi)&" ..<br>")
response.Flush()
call PostHttpPage_x(myyy_strPath, newd_soft_update_center, LData)
if http_url_err=1 then
response.write("连接"&newd_main_ww_b(ipipi)&"时出现异常,正在试图连接其他服务器 ..<br>")
response.Flush()
else
response.write("成功连接到 "&newd_main_ww_b(ipipi)&" ..<br>")
response.Flush()
end if
if http_url_err=0 then
get_ok_server=1
exit function
end if
if ipipi=(newd_main_ww_b_len-1) then
get_ok_server=0
end if
next
else
response.write("成功连接到 "&newd_main_ww&" ..<br>")
response.Flush()
get_ok_server=1
end if
End Function
'连接到官方网站并检查是否 有要更新的内容..,如果有,则返回更新包xml的url
function get_if_have_newest_update_from_newdsoft()
use_http_url=1
get_if_have_newest_update_from_newdsoft="0"
http_url_err=0
is_hsassdd=ReadXMLDocumenthttp(newd_soft_update_center,"is_have")
if http_url_err=1 then
response.write("<font color=#ff0000>本系统的官方网站的服务器出现了异常,请稍后更新,我们将尽快恢复服务器,您也可以直接联系我们,通知我们这个异常..</font>")
response.write("<script language=javascript>alert('本系统的官方网站的服务器出现了异常,请稍后更新,我们将尽快恢复服务器,您也可以直接联系我们,通知我们这个异常..');</script>")
exit function
end if
if trim(rep_xml_br(is_hsassdd))="1" then
get_if_have_newest_update_from_newdsoft="1"
else
get_if_have_newest_update_from_newdsoft="0"
end if
End Function
'如果is_auto=1 则自动检查有无新的升级包,如果有则执行在线自动更新,
'如果is_auto=0 则执行在线更新set_update_url里指定的升级包(xml格式)
Function get_newest_update_from_newdsoft(is_auto,set_update_url)
use_http_url=1
'为了发现无效网址请加下面这行
On Error Resume Next
if is_auto=0 then
use_http_post=0
response.write("在线更新程序启动成功..<br>")
response.write("正在连接到 "&set_update_url&" 并检查是否 有要更新的内容..<br>")
http_url_err=0
set aasc=ReadXMLDocument_nodes(set_update_url,"update_list")
if http_url_err=1 then
response.write("<font color=#ff0000>升级服务器出现了异常,请稍后更新..</font>")
response.write("<script language=javascript>alert('升级服务器出现了异常,请稍后更新..');</script>")
response.Flush()
exit function
end if
for aiaa=0 to aasc.length-1
nnnname=trim(rep_xml_br(aasc(aiaa).selectSingleNode("pack_name").text))
uueueueru=trim(rep_xml_br(aasc(aiaa).selectSingleNode("update_xml_url_for_you").text))
nnnnamess=nnnnamess&"<br>"&nnnname
next
response.write("需要更新的更新包列表如下:"&nnnnamess)
response.write("<br><font style='font-size:13px;color=#0000ff'>发现了"&aasc.length&"个更新.. , <a href='adminSysTools/D_ist_updt_cst.asp?xurl="&set_update_url&"' target='_self'><font style='font-size:13px;color=#ff0000'>点击这里开始安装这"&aasc.length&"个更新</font></a></font><br>")
response.write("提示:安装更新前请先备份好系统,以免发生意外..")
response.write("<script language=javascript>if(confirm('发现了"&aasc.length&"个系统更新,要安装这"&aasc.length&"个更新来升级你的系统吗?,点击确定将自动开始安装,(提示:安装更新前请先备份好系统,以免发生意外..)')==true){self.location='adminSysTools/D_ist_updt_cst.asp?xurl="&set_update_url&"';}</script>")
end if
if is_auto=1 then
response.write("在线自动更新程序启动成功..<br>")
response.write("正在连接到官方网站并检查是否 有要更新的内容..<br>")
response.Flush()
use_http_post=1
if get_ok_server()=0 then
response.write("<font color=#ff0000>本系统的官方网站的服务器出现了异常,请稍后更新,我们将尽快恢复服务器,您也可以直接联系我们,通知我们这个异常..</font>")
response.write("<script language=javascript>alert('本系统的官方网站的服务器出现了异常,请稍后更新,我们将尽快恢复服务器,您也可以直接联系我们,通知我们这个异常..');</script>")
exit function
end if
retefee=get_if_have_newest_update_from_newdsoft()
if http_url_err=1 then
exit function
end if
use_http_post=1
if retefee="0" then
response.write("<font color=#ff0000>没有发现更新..</font><br>")
else
set aasc=ReadXMLDocument_nodes(newd_soft_update_center,"update_list")
for aiaa=0 to aasc.length-1
nnnname=trim(rep_xml_br(aasc(aiaa).selectSingleNode("pack_name").text))
uueueueru=trim(rep_xml_br(aasc(aiaa).selectSingleNode("update_xml_url_for_you").text))
nnnnamess=nnnnamess&"<br>"&nnnname
next
response.write("需要更新的更新包列表如下:"&nnnnamess)
response.write("<br><font style='font-size:13px;color=#0000ff'>发现了"&aasc.length&"个更新.. , <a href='adminSysTools/D_ist_updt.asp' target='_self'><font style='font-size:13px;color=#ff0000'>点击这里开始安装这"&aasc.length&"个更新</font></a></font><br>")
response.write("提示:安装更新前请先备份好系统,以免发生意外..")
response.write("<script language=javascript>if(confirm('发现了"&aasc.length&"个系统更新,要安装这"&aasc.length&"个更新来升级你的系统吗?,点击确定将自动开始安装,(提示:安装更新前请先备份好系统,以免发生意外..)')==true){self.location='adminSysTools/D_ist_updt.asp';}</script>")
end if
end if
End Function
Function update_qiantai_web_filenames_config_xml(is_cms)
set fileaw=new Cls_FSO
set filebw=new DosAsp
set rs112=server.CreateObject("adodb.recordset")
if is_cms=1 then
rs112.open "select * from ND_templates_folder_reg where is_default_template=true",conn,1,1
else
rs112.open "select * from ND_templates_folder_reg_qiye where is_default_template=true",conn,1,1
end if
if rs112.eof then
exit function
else
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../../"&ppath&iscrtfile
use_http_url=0
use_http_post=0
set fileaw=new Cls_FSO
set filebw=new DosAsp
if fileaw.ReportFileStatus(server.mappath(scrt_ff))=-1 then
'模板目录下不存在"&iscrtfile&"安装脚本文件
sconts=loadfile("../../inc/"&w_web_config_template)
call SaveXMLDocument_newindexc(scrt_ff,sconts,is_cms)
scrt_ff="../../"&ppath&w_files_config
sconts=loadfile("../../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
else
'模板目录下存在"&iscrtfile&"安装脚本文件
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_fff="../../"&ppath&xm_d_c
if fileaw.ReportFileStatus(server.mappath(scrt_fff))=-1 then
scrt_ff="../../"&ppath&xm_d_c
sconts=loadfile("../../inc/"&w_files_config_template)
call SaveXMLDocument(scrt_ff,sconts)
end if
end if
ppath="templates/"&rs112("templates_folder_path_name")&"/"
scrt_ff="../../"&ppath&iscrtfile
xm_d_c=ReadXMLDocument(scrt_ff,"all_web_file_name_and_type_config")
scrt_ff="../../"&ppath&xm_d_c
set aasc=ReadXMLDocument_nodes(scrt_ff,"files/file_reg")
biao="[ND_channel]"
if is_cms=1 then is_a_b="0"
if is_cms=0 then is_a_b="1"
set Rs=server.CreateObject("adodb.recordset")
set Rs22k=server.CreateObject("adodb.recordset")
sql="select * from "&biao&" where is_qiye="&is_a_b&" order by clng(orders) asc"
Rs.open sql,conn,1,1
do while not rs.eof
for aiaa=0 to aasc.length-1
aassaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filetype").text))
bbssbb=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filename").text))
'ccsscc=trim(rep_xml_br(aasc(aiaa).selectSingleNode("to_html_filename").text))
if lcase(trim(rs("channel_file_url")))=lcase(trim("$page$"&aassaa)) then
sql="select * from "&biao&" where id="&rs("id")
Rs22k.open sql,conn,1,3
Rs22k("dyn_channel_file_url")=bbssbb&"?id="&rs("sys_content_type_name")
Rs22k.update
Rs22k.close
exit for
end if
next
if instr(1,lcase(rs("channel_file_url")),"$cstpage$",1)<>0 then
sql="select * from "&biao&" where id="&rs("id")
Rs22k.open sql,conn,1,3
f_f_a_f_s=mid(rs("channel_file_url"),instr(1,lcase(trim(rs("channel_file_url"))),"$cstpage$",1)+9,len(rs("channel_file_url"))-(instr(1,lcase(trim(rs("channel_file_url"))),"$cstpage$",1)+9)+1)
'针对$cstpage$$page$down_index_page$之类的解析
for aiaa=0 to aasc.length-1
aassaa=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filetype").text))
bbssbb=trim(rep_xml_br(aasc(aiaa).selectSingleNode("filename").text))
'ccsscc=trim(rep_xml_br(aasc(aiaa).selectSingleNode("to_html_filename").text))
if lcase(trim(f_f_a_f_s))=lcase(trim("$page$"&aassaa&"$")) then
f_f_a_f_s=bbssbb
exit for
end if
next
Rs22k("dyn_channel_file_url")=f_f_a_f_s
Rs22k.update
Rs22k.close
end if
rs.movenext
loop
Rs.close
end if
End Function
Function all_update_qiantai_web_filenames_config_xml()
call update_qiantai_web_filenames_config_xml(1)
call update_qiantai_web_filenames_config_xml(0)
'更新前台频道内部链接
End Function
Private Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
Actforip = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Actforip = Request.ServerVariables("REMOTE_ADDR")
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Actforip = Request.ServerVariables("REMOTE_ADDR")
End If
getIP = Replace(Trim(Mid(strIPAddr, 1, 30)), "'", "")
End Function
'==================================================
'函数名：DefiniteUrl
'作 用：将相对地址转换为绝对地址
'参 数：PrimitiveUrlStr ------要转换的相对地址
'参 数：ConsultUrlStr ------当前网页地址
'==================================================
'Function DefiniteUrl(ByVal PrimitiveUrlStr, ByVal ConsultUrlStr)
Function DefiniteUrl(PrimitiveUrl, ConsultUrl)
Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Dim PrimitiveUrlStr, ConsultUrlStr
PrimitiveUrlStr = PrimitiveUrl
ConsultUrlStr = ConsultUrl
If PrimitiveUrlStr = "" Or ConsultUrlStr = "" Or PrimitiveUrlStr = "Error" Or ConsultUrlStr = "Error" Then
DefiniteUrl = "Error"
Exit Function
End If
If Left(LCase(ConsultUrlStr), 7) <> "http://" Then
ConsultUrlStr = "http://" & ConsultUrlStr
End If
ConsultUrlStr = Replace(ConsultUrlStr, "\", "/")
ConsultUrlStr = Replace(ConsultUrlStr, "://", ":\\")
PrimitiveUrlStr = Replace(PrimitiveUrlStr, "\", "/")
If Right(ConsultUrlStr, 1) <> "/" Then
If InStr(ConsultUrlStr, "/") > 0 Then
If InStr(Right(ConsultUrlStr, Len(ConsultUrlStr) - InStrRev(ConsultUrlStr, "/")), ".") > 0 Then
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
Else
ConsultUrlStr = ConsultUrlStr & "/"
End If
End If
ConArray = Split(ConsultUrlStr, "/")
If Left(LCase(PrimitiveUrlStr), 7) = "http://" Then
DefiniteUrl = Replace(PrimitiveUrlStr, "://", ":\\")
ElseIf Left(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = ConArray(0) & PrimitiveUrlStr
ElseIf Left(PrimitiveUrlStr, 2) = "./" Then
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 2)
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
ElseIf Left(PrimitiveUrlStr, 3) = "../" Then
Do While Left(PrimitiveUrlStr, 3) = "../"
PrimitiveUrlStr = Right(PrimitiveUrlStr, Len(PrimitiveUrlStr) - 3)
Pi = Pi + 1
Loop
For Ci = 0 To (UBound(ConArray) - 1 - Pi)
If DefiniteUrl <> "" Then
DefiniteUrl = DefiniteUrl & "/" & ConArray(Ci)
Else
DefiniteUrl = ConArray(Ci)
End If
Next
DefiniteUrl = DefiniteUrl & "/" & PrimitiveUrlStr
Else
If InStr(PrimitiveUrlStr, "/") > 0 Then
PriArray = Split(PrimitiveUrlStr, "/")
If InStr(PriArray(0), ".") > 0 Then
If Right(PrimitiveUrlStr, 1) = "/" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
If InStr(PriArray(UBound(PriArray) - 1), ".") > 0 Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr
Else
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & PrimitiveUrlStr
End If
End If
Else
If InStr(PrimitiveUrlStr, ".") > 0 Then
If Right(ConsultUrlStr, 1) = "/" Then
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr
End If
Else
If Right(LCase(PrimitiveUrlStr), 3) = ".cn" Or Right(LCase(PrimitiveUrlStr), 3) = "com" Or Right(LCase(PrimitiveUrlStr), 3) = "net" Or Right(LCase(PrimitiveUrlStr), 3) = "org" Then
DefiniteUrl = "http:\\" & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr
End If
End If
Else
If Right(ConsultUrlStr, 1) = "/" Then
DefiniteUrl = ConsultUrlStr & PrimitiveUrlStr & "/"
Else
DefiniteUrl = Left(ConsultUrlStr, InStrRev(ConsultUrlStr, "/")) & "/" & PrimitiveUrlStr & "/"
End If
End If
End If
End If
If Left(DefiniteUrl, 1) = "/" Then
DefiniteUrl = Right(DefiniteUrl, Len(DefiniteUrl) - 1)
End If
If DefiniteUrl <> "" Then
DefiniteUrl = Replace(DefiniteUrl, "//", "/")
DefiniteUrl = Replace(DefiniteUrl, ":\\", "://")
Else
DefiniteUrl = "Error"
End If
'我加进去的
If CheckTheChar("http://", DefiniteUrl) > 1 Then
DefiniteUrl = "http://" & Replace(DefiniteUrl, "http://", "")
End If
End Function
'**************************************************
'函数名：CreateKeyWord
'作 用：由给定的字符串生成关键字
'参 数：Constr---要生成关键字的原字符串
'返回值：生成的关键字
'**************************************************
Function CreateKeyWord_x(ByVal Constr, num)
If Constr = "" Or IsNull(Constr) = True Or Constr = "Error" Then
CreateKeyWord_x = "Error"
Exit Function
End If
If num = "" Or IsNumeric(num) = False Then
num = 2
End If
Constr = Replace(Constr, Chr(32), "")
Constr = Replace(Constr, Chr(9), "")
Constr = Replace(Constr, " ", "")
Constr = Replace(Constr, " ", "")
Constr = Replace(Constr, "(", "")
Constr = Replace(Constr, ")", "")
Constr = Replace(Constr, "<", "")
Constr = Replace(Constr, ">", "")
Constr = Replace(Constr, """", "")
Constr = Replace(Constr, "?", "")
Constr = Replace(Constr, "*", "")
Constr = Replace(Constr, "|", "")
Constr = Replace(Constr, ",", "")
Constr = Replace(Constr, ".", "")
Constr = Replace(Constr, "/", "")
Constr = Replace(Constr, "\", "")
Constr = Replace(Constr, "-", "")
Constr = Replace(Constr, "@", "")
Constr = Replace(Constr, "#", "")
Constr = Replace(Constr, "$", "")
Constr = Replace(Constr, "%", "")
Constr = Replace(Constr, "&", "")
Constr = Replace(Constr, "+", "")
Constr = Replace(Constr, ":", "")
Constr = Replace(Constr, "：", "")
Constr = Replace(Constr, "‘", "")
Constr = Replace(Constr, "“", "")
Constr = Replace(Constr, "”", "")
For i = 1 To Len(Constr)
ConstrTemp = ConstrTemp & Mid(Constr, i, num) & "|"
Next
If Len(ConstrTemp) < 254 Then
ConstrTemp = ConstrTemp
Else
ConstrTemp = Left(ConstrTemp, 254)
End If
CreateKeyWord_x = Left(ConstrTemp, Len(ConstrTemp) - 1)
End Function
%>